diff --git a/.Rbuildignore b/.Rbuildignore
index cf44746..07cff67 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -2,3 +2,9 @@
^\.Rproj\.user$
^README\.Rmd$
^LICENSE\.md$
+^cran-comments\.md$
+^CRAN-SUBMISSION$
+^_pkgdown\.yml$
+^docs$
+^pkgdown$
+^\.github$
diff --git a/.github/.gitignore b/.github/.gitignore
new file mode 100644
index 0000000..2d19fc7
--- /dev/null
+++ b/.github/.gitignore
@@ -0,0 +1 @@
+*.html
diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml
new file mode 100644
index 0000000..bfc9f4d
--- /dev/null
+++ b/.github/workflows/pkgdown.yaml
@@ -0,0 +1,49 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+ push:
+ branches: [main, master]
+ pull_request:
+ release:
+ types: [published]
+ workflow_dispatch:
+
+name: pkgdown.yaml
+
+permissions: read-all
+
+jobs:
+ pkgdown:
+ runs-on: ubuntu-latest
+ # Only restrict concurrency for non-PR jobs
+ concurrency:
+ group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
+ env:
+ GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+ permissions:
+ contents: write
+ steps:
+ - uses: actions/checkout@v4
+
+ - uses: r-lib/actions/setup-pandoc@v2
+
+ - uses: r-lib/actions/setup-r@v2
+ with:
+ use-public-rspm: true
+
+ - uses: r-lib/actions/setup-r-dependencies@v2
+ with:
+ extra-packages: any::pkgdown, local::.
+ needs: website
+
+ - name: Build site
+ run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
+ shell: Rscript {0}
+
+ - name: Deploy to GitHub pages 🚀
+ if: github.event_name != 'pull_request'
+ uses: JamesIves/github-pages-deploy-action@v4.5.0
+ with:
+ clean: false
+ branch: gh-pages
+ folder: docs
diff --git a/.gitignore b/.gitignore
index b70a570..652758e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -7,3 +7,4 @@ diego.txt
.m
.mat
.csv
+docs
diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION
new file mode 100644
index 0000000..04b6fae
--- /dev/null
+++ b/CRAN-SUBMISSION
@@ -0,0 +1,3 @@
+Version: 1.0.3
+Date: 2023-06-04 13:27:38 UTC
+SHA: f54cd023b2e6bb2de1e74d1d0c89c13828149c44
diff --git a/DESCRIPTION b/DESCRIPTION
index f14db16..eb23328 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,26 +1,33 @@
Package: DemoKin
-Title: Demokin
-Description: Estimate population kin counts and its distribution by type and age
-Version: 1.0.0
+Title: Estimate Population Kin Distribution
+Description: Estimate population kin counts and its distribution by type, age and sex.
+ The package implements one-sex and two-sex framework for studying living-death availability,
+ with time varying rates or not, and multi-stage model.
+Version: 1.0.3
Authors@R: c(
- person("Iván", "Williams", email = "act.ivanwilliams@gmail.com", role = "cre"),
+ person("Iván", "Williams", email = "act.ivanwilliams@gmail.com", role = c("aut", "cre")),
person("Diego", "Alburez-Gutierrez", email = "alburezgutierrez@demogr.mpg.de", role = "aut"),
- person("Xi", "Song", email = "xisong@sas.upenn.edu", role = "ctb"))
+ person("Xi", "Song", email = "xisong@sas.upenn.edu", role = "ctb"),
+ person("Hal", "Caswell", email = "caswell@demogr.mpg.de", role = "ctb"),
+ person("Benjamin", "Schlüter", email = "benjamin.schluter@utoronto.ca", role = "ctb"),
+ person("Joe", "Butterick", email = "J.Butterick@soton.ac.uk", role = "ctb"),
+ person("Sha", "Jiang", email = "jiang@demogr.mpg.de", role = "ctb"))
License: MIT + file LICENSE
Encoding: UTF-8
LazyData: true
Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
Suggests:
knitr,
rmarkdown,
- testthat (>= 3.0.0)
+ testthat (>= 3.0.0),
+ ggplot2,
+ pkgdown
VignetteBuilder: knitr
Imports:
dplyr,
tidyr,
purrr,
- HMDHFDplus,
progress,
matrixcalc,
Matrix,
@@ -28,7 +35,12 @@ Imports:
stats,
igraph,
magrittr,
- lifecycle
+ data.table,
+ lifecycle,
+ tictoc,
+ reshape2
+URL: https://github.com/IvanWilli/DemoKin,
+ https://ivanwilli.github.io/DemoKin/
BugReports: https://github.com/IvanWilli/DemoKin/issues
Depends:
R (>= 2.10)
diff --git a/NAMESPACE b/NAMESPACE
index f5c7de1..7fa2b73 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,12 +1,20 @@
# Generated by roxygen2: do not edit by hand
export("%>%")
-export(demokin_codes)
-export(get_HMDHFD)
export(kin)
+export(kin2sex)
export(kin_multi_stage)
+export(kin_multi_stage_time_variant_2sex)
export(kin_time_invariant)
+export(kin_time_invariant_2sex)
+export(kin_time_invariant_2sex_cod)
export(kin_time_variant)
+export(kin_time_variant_2sex)
+export(kin_time_variant_2sex_cod)
+export(output_period_cohort_combination)
export(plot_diagram)
export(rename_kin)
+export(timevarying_kin)
+export(timevarying_kin_2sex)
+export(timevarying_kin_2sex_cod)
importFrom(magrittr,"%>%")
diff --git a/NEWS.md b/NEWS.md
index 1db9e6f..cfc0438 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,6 +1,16 @@
+# DemoKin 1.0.3
+
+# DemoKin 1.0.2
+
+# DemoKin 1.0.1
+
# DemoKin 1.0.0
* Added a `NEWS.md` file to track changes to the package.
* Change stable/non-stable references to time varying/non-varying rates.
* Add multi-state process.
+# DemoKin 1.0.1
+* Submitted to CRAN
+* Death counts are placed in the age where Focal experience the death.
+* Aggregated kin types are allowed (`s` for older and younger sisters, for example).
diff --git a/R/aux_funs.R b/R/aux_funs.R
index e8c745b..a8e7bfd 100644
--- a/R/aux_funs.R
+++ b/R/aux_funs.R
@@ -1,49 +1,17 @@
-
-#' print kin codes
-#' @description Print kin codes and labels
-#' @export
-demokin_codes <- function(){
- codes <- c("coa", "cya", "d", "gd", "ggd", "ggm", "gm", "m", "nos", "nys", "oa", "ya", "os", "ys")
- caswell_codes <- c("t", "v", "a", "b", "c", "h", "g", "d", "p", "q", "r", "s", "m", "n")
- labels <- c("Cousins from older aunt", "Cousins from younger aunt", "Daughter", "Grand-daughter", "Great-grand-daughter", "Great-grandmother", "Grandmother", "Mother", "Nieces from older sister", "Nieces from younger sister", "Aunt older than mother", "Aunt younger than mother", "Older sister", "Younger sister")
- data.frame(DemoKin = codes, Caswell = caswell_codes, Label = labels, row.names = NULL)
-}
-
#' rename kin
-#' @description Rename kin labels depending consolidate some types
-#' @export
-rename_kin <- function(df, consolidate_column = "no"){
-
- stopifnot("Argument 'consolidate_column' should be 'no' or a valid column name" = consolidate_column %in% c("no", colnames(df)))
-
- if(consolidate_column == "no"){
-
- relatives <- c("Cousins from older aunt", "Cousins from younger aunt", "Daughter", "Grand-daughter", "Great-grand-daughter", "Great-grandmother", "Grandmother", "Mother", "Nieces from older sister", "Nieces from younger sister", "Aunt older than mother", "Aunt younger than mother", "Older sister", "Younger sister")
- names(relatives) <- c("coa", "cya", "d", "gd", "ggd", "ggm", "gm", "m", "nos", "nys", "oa", "ya", "os", "ys")
- } else {
-
- # Combine kin types irrespective of whether they come from older
- # or younger sibling lines
- consolidate_vec <- c("c", "c", "d", "gd", "ggd", "ggm", "gm", "m", "n", "n", "a", "a", "s", "s")
- names(consolidate_vec) <- c("coa", "cya", "d", "gd", "ggd", "ggm", "gm", "m", "nos", "nys", "oa", "ya", "os", "ys")
-
- # Rename kin types from codes to actual words
- relatives <- c("Cousins", "Daughter", "Grand-daughter", "Great-grand-daughter", "Great-grandmother", "Grandmother", "Mother", "Nieces", "Aunt", "Sister")
- names(relatives) <- unique(consolidate_vec)
-
- df <- as.data.frame(df)
- df$count <- df[ , consolidate_column]
-
- df <-
- df %>%
- dplyr::mutate(kin = consolidate_vec[kin]) %>%
- dplyr::group_by(age_focal, kin) %>%
- dplyr::summarise(count = sum(count)) %>%
- dplyr::ungroup()
-
-
- }
- df$kin <- relatives[df$kin]
- df
+#' @description Add kin labels depending the sex
+#' @details See table `demokin_codes` to know label options.
+#' @param df data.frame. A data frame with variable `kin` with `DemoKin` codes to be labelled.
+#' @param sex character. "f" for female, "m" for male or "2sex" for both sex naming.
+#' @return Add a column with kin labels in the input data frame.
+#' @export
+rename_kin <- function(df, sex = "f"){
+ if(!"kin" %in% names(df)) stop("Input df needs a column named kin.")
+ if(sex == "f") demokin_codes_sex <- DemoKin::demokin_codes[,c("DemoKin", "Labels_female")]
+ if(sex == "m") demokin_codes_sex <- DemoKin::demokin_codes[,c("DemoKin", "Labels_male")]
+ if(sex == "2sex") demokin_codes_sex <- DemoKin::demokin_codes[,c("DemoKin", "Labels_2sex")]
+ colnames(demokin_codes_sex) <- c("kin", "kin_label")
+ df %>%
+ dplyr::left_join(demokin_codes_sex)
}
diff --git a/R/data.R b/R/data.R
index 1bacb90..7a4db6b 100644
--- a/R/data.R
+++ b/R/data.R
@@ -1,5 +1,99 @@
-#' Female swedish survival ratios from 1900 to 2015
-#'
+#' Singapore: List of matrices that redistribute newborns to age-class 1 and "no education" category
+#' @docType data
+#' @format
+#' The data is aggregated into 5-year age groups and 5-year time intervals
+#' @source
+#' Wittgenstein Center
+"H_mat_edu"
+
+#' Singapore: Lists of transition matrices showing probabilities of moving between education states. Females
+#' @docType data
+#' @format
+#' The data is aggregated into 5-year age groups and 5-year time intervals
+#' @source
+#' Wittgenstein Center
+"T_mat_fem_edu"
+
+#' Singapore: Lists of transition matrices showing probabilities of moving between education states. Males
+#' @docType data
+#' @format
+#' The data is aggregated into 5-year age groups and 5-year time intervals
+#' @source
+#' Wittgenstein Center
+"T_mat_male_edu"
+
+#' Singapore: Lists of matrices containing fertility rates by age and education. Females
+#' @docType data
+#' @format
+#' The data is aggregated into 5-year age groups and 5-year time intervals
+#' @source
+#' Wittgenstein Center
+"F_mat_fem_edu"
+
+#' Singapore: Lists of matrices containing fertility rates by age and education. Males
+#' @docType data
+#' @format
+#' The data is aggregated into 5-year age groups and 5-year time intervals
+#' @source
+#' Wittgenstein Center
+"F_mat_male_edu"
+
+#' Singapore: Lists of matrices containing survival probabilities by age (rows) and education (columns) from 2020-2090. Females
+#' @docType data
+#' @format
+#' The data is aggregated into 5-year age groups and 5-year time intervals
+#' @source
+#' Wittgenstein Center
+"U_mat_fem_edu"
+
+#' Singapore: Lists of matrices containing survival probabilities by age (rows) and education (columns) from 2020-2090. Males
+#' @docType data
+#' @format
+#' The data is aggregated into 5-year age groups and 5-year time intervals
+#' @source
+#' Wittgenstein Center
+"U_mat_male_edu"
+
+#' UK female fertility from 1965 to 2022
+#' @docType data
+#' @format
+#' list of age by stage matrices, entries give female fert. List starting 1965 ending 2022.
+#' @source
+#' HFD and ONS
+"Female_parity_fert_list_UK"
+
+#' UK female parity transitions from 1965 to 2022
+#' @docType data
+#' @format
+#' list of age by stage matrices, entries give female parity transitions. List starting 1965 ending 2022.
+#' @source
+#' HFD and ONS
+"Parity_transfers_by_age_list_UK"
+
+#' UK female parity mortality from 1965 to 2022
+#' @docType data
+#' @format
+#' list of age by stage matrices, entries give female parity mortality List starting 1965 ending 2022.
+#' @source
+#' HFD and ONS
+"Female_parity_mortality_list_UK"
+
+#' UK male parity mortality from 1965 to 2022
+#' @docType data
+#' @format
+#' list of age by stage matrices, entries give male parity mortality List starting 1965 ending 2022.
+#' @source
+#' HFD and ONS
+"Male_parity_mortality_list_UK"
+
+#' UK parity assign parity at birth
+#' @docType data
+#' @format
+#' list of matrices which redistributes newborns to age-class 1 and parity 0. No time-variation.
+#' @source
+#' None
+"Redistribution_by_parity_list_UK"
+
#' Female swedish survival ratios from 1900 to 2015
#' @docType data
#' @format
@@ -127,3 +221,34 @@
#' @source
#' Caswell (2021)
"kin_svk1990_caswell2020"
+
+#' Fertility for France (2012) by sex in Caswell (2022).
+#'
+#' Fertility for France (2012) by sex in Caswell (2022).
+#' @docType data
+#' @format
+#' A data.frame with age specific fertility rates by age and sex.
+#'
+#' @source
+#' Caswell (2022)
+"fra_asfr_sex"
+
+#' Survival probability for France (2012) by sex in Caswell (2022).
+#'
+#' Survival probability for France (2012) by sex in Caswell (2022).
+#' @docType data
+#' @format
+#' A data.frame with survival probabilities by age and sex.
+#'
+#' @source
+#' Caswell (2022)
+"fra_surv_sex"
+
+#' DemoKin codes, Caswell (2020) codes, and useful labels.
+#'
+#' DemoKin codes, Caswell (2020) codes, and useful labels.
+#' @docType data
+#' @format
+#' A data.frame with codes and labels for distinction between kin types.
+
+"demokin_codes"
diff --git a/R/get_HMDHFD.R b/R/get_HMDHFD.R
deleted file mode 100644
index b4ee78e..0000000
--- a/R/get_HMDHFD.R
+++ /dev/null
@@ -1,125 +0,0 @@
-#' Get time serie matrix data from HMD/HFD
-
-#' @description Wrapper function to get data of female survival, fertlity and population
-#' of selected country on selected period.
-
-#' @param country numeric. Country code from rom HMD/HFD.
-#' @param max_year numeric. Latest year to get data.
-#' @param min_year integer. Older year to get data.
-#' @param user_HMD character. From HMD.
-#' @param user_HFD character. From HFD.
-#' @param pass_HMD character. From HMD.
-#' @param pass_HFD character. From HFD.
-#' @param OAG numeric. Open age group to standarize output.
-#' @return A list wiith female survival probability, survival function, fertility and poopulation age specific matrixes, with calendar year as colnames.
-#' @export
-
-get_HMDHFD <- function(country = "SWE",
- min_year = 1900,
- max_year = 2018,
- user_HMD = NULL,
- pass_HMD = NULL,
- user_HFD = NULL,
- pass_HFD = NULL,
- OAG = 100){
-
- if(any(c(is.null(user_HMD), is.null(user_HFD), is.null(pass_HMD), is.null(pass_HFD)))){
- stop("The function needs HMD and HMF access.")
- }
-
- # source HMD HFD -----------------------------------------------------------------
- pop <- HMDHFDplus::readHMDweb(CNTRY = country, "Population", user_HMD, pass_HMD, fixup = TRUE) %>%
- dplyr::select(Year, Age, N = Female1)%>%
- dplyr::filter(Year >= min_year, Year <= max_year)
- lt <- HMDHFDplus::readHMDweb(country, "fltper_1x1", user_HMD, pass_HMD, fixup = TRUE) %>%
- dplyr::filter(Year >= min_year, Year <= max_year)
- asfr <- HMDHFDplus::readHFDweb(country, "asfrRR", user_HFD, pass_HFD, fixup = TRUE)%>%
- dplyr::filter(Year >= min_year, Year <= max_year)
-
- # list of yearly Leslie matrix ---------------------------------------------------
-
- age = 0:OAG
- ages = length(age)
- w = last(age)
- last_year = max(lt$Year)
- years = min_year:last_year
-
- # survival probability
- px <- lt %>%
- dplyr::filter(Age<=OAG) %>%
- dplyr::mutate(px = 1 - qx,
- px = ifelse(Age==OAG, 0, px)) %>%
- dplyr::select(Year, Age, px) %>%
- tidyr::pivot_wider(names_from = "Year", values_from = "px") %>%
- dplyr::select(-Age) %>%
- as.matrix()
- rownames(px) = 0:OAG
-
- # survival function
- Lx <- lt %>%
- dplyr::filter(Age<=OAG) %>%
- dplyr::mutate(Lx = ifelse(Age==OAG, Tx, Lx)) %>%
- dplyr::select(Year, Age, Lx) %>%
- tidyr::pivot_wider(names_from = "Year", values_from = "Lx") %>%
- dplyr::select(-Age) %>%
- as.matrix()
-
- Sx <- rbind(Lx[c(-1,-ages),]/Lx[-c(w:ages),],
- Lx[ages,]/(Lx[w,]+Lx[ages,]),
- Lx[ages,]/(Lx[w,]+Lx[ages,]))
- rownames(Sx) = 0:w
-
- # fertility
- fx <- asfr %>%
- dplyr::filter(Year >= min_year) %>%
- dplyr::select(-OpenInterval) %>%
- rbind(
- expand.grid(Year = years,
- Age = c(0:(min(asfr$Age)-1),(max(asfr$Age)+1):OAG),
- ASFR = 0)) %>%
- dplyr::arrange(Year, Age) %>%
- tidyr::spread(Year, ASFR) %>%
- dplyr::select(-Age) %>%
- as.matrix()
- rownames(fx) = 0:OAG
-
- # population
- Nx <- pop %>%
- dplyr::mutate(Age = ifelse(Age>OAG, OAG, Age)) %>%
- dplyr::group_by(Year, Age) %>% summarise(N = sum(N)) %>%
- dplyr::filter(Age<=OAG, Year >= min_year) %>%
- dplyr::arrange(Year, Age) %>%
- tidyr::spread(Year, N) %>%
- dplyr::select(-Age) %>%
- as.matrix()
- rownames(Nx) = 0:OAG
-
- # only return data with values
- if(any(is.na(colSums(Sx)))){
- warning("Asked for data out of HMDHFD range")
- Sx <- Sx[,!is.na(colSums(Sx))]
- }
- if(any(is.na(colSums(fx)))){
- warning("Asked for data out of HMDHFD range")
- fx <- fx[,!is.na(colSums(fx))]
- }
- if(any(is.na(colSums(Nx)))){
- warning("Asked for data out of HMDHFD range")
- Nx <- Nx[,!is.na(colSums(Nx))]
- }
-
- return(list(px=px,
- Sx=Sx,
- fx=fx,
- Nx=Nx))
-}
-
-# save data
- # swe_px <- swe_data$px
- # swe_Sx <- swe_data$Sx
- # swe_asfr <-swe_data$fx
- # swe_pop <- swe_data$Nx
- # save(swe_px, file = "data/swe_px.rda")
- # save(swe_Sx, file = "data/swe_Sx.rda")
- # save(swe_asfr, file = "data/swe_asfr.rda")
- # save(swe_pop, file = "data/swe_pop.rda")
diff --git a/R/kin.R b/R/kin.R
index e9a5669..ac782c2 100644
--- a/R/kin.R
+++ b/R/kin.R
@@ -1,20 +1,27 @@
-#' Estimate kin counts
+#' Estimate kin counts in a one-sex framework.
-#' @description Implementation of Goodman-Keyfitz-Pullum equations in a matrix framework.
+#' @description Implementation of Goodman-Keyfitz-Pullum equations in a matrix framework. This produce a matrilineal (or patrilineal)
+#' kin count distribution by kin and age.
#' @details See Caswell (2019) and Caswell (2021) for details on formulas. One sex only (female by default).
-#' @param U numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).
-#' @param f numeric. Same as U but for fertility rates.
+#' @param p numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class
+#' in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).
+#' @param f numeric. Same as `p` but for fertility rates.
#' @param time_invariant logical. Constant assumption for a given `year` rates. Default `TRUE`.
-#' @param N numeric. Same as U but for population distribution (counts or `%`). Optional.
-#' @param pi numeric. Same as U but for childbearing distribution (sum to 1). Optional.
+#' @param n numeric. Only for `time_invariant = FALSE`. Same as `p` but for population distribution (counts or `%`). Optional.
+#' @param pi numeric. Same as `U` but for childbearing distribution (sum to 1). Optional.
#' @param output_cohort integer. Vector of year cohorts for returning results. Should be within input data years range.
#' @param output_period integer. Vector of period years for returning results. Should be within input data years range.
#' @param output_kin character. kin types to return: "m" for mother, "d" for daughter,...
-#' @param birth_female numeric. Female portion at birth. This multiplies `f` argument. If `f` is already for female offspring, this needs to be set as 1.
+#' @param output_age_focal integer. Vector of ages to select (and make faster the run).
+#' @param birth_female numeric. Female portion at birth. This multiplies `f` argument. If `f` is already for female offspring,
+#' @param summary_kin logical. Whether or not include `kin_summary` table (see output details). Default `TRUE`.
+#' this needs to be set as 1.
#' @return A list with:
#' \itemize{
-#' \item{kin_full}{ a data frame with year, cohort, Focal´s age, related ages and type of kin (for example `d` is daughter, `oa` is older aunts, etc.), including living and dead kin at that age.}
-#' \item{kin_summary}{ a data frame with Focal´s age, related ages and type of kin, with indicators obtained processing `kin_full`, grouping by cohort or period (depending on the given arguments):}
+#' \item{kin_full}{ a data frame with year, cohort, Focal´s age, related ages and type of kin (for example `d` is daughter,
+#' `oa` is older aunts, etc.), including living and dead kin at that age.}
+#' \item{kin_summary}{ a data frame with Focal´s age, related ages and type of kin, with indicators obtained processing `kin_full`,
+#' grouping by cohort or period (depending on the given arguments):}
#' {\itemize{
#' \item{`count_living`}{: count of living kin at actual age of Focal}
#' \item{`mean_age`}{: mean age of each type of living kin.}
@@ -25,58 +32,76 @@
#' }
#' }
#' }
-
#' @export
-#'
-# get kin ----------------------------------------------------------------
-kin <- function(U = NULL, f = NULL,
- time_invariant = TRUE,
- N = NULL, pi = NULL,
- output_cohort = NULL, output_period = NULL, output_kin=NULL,
- birth_female = 1/2.04,
- stable = lifecycle::deprecated())
- {
+#' @examples
+#' # Kin expected matrilineal count for a Swedish female based on 2015 rates.
+#' swe_surv_2015 <- swe_px[,"2015"]
+#' swe_asfr_2015 <- swe_asfr[,"2015"]
+#' # Run kinship models
+#' swe_2015 <- kin(p = swe_surv_2015, f = swe_asfr_2015)
+#' head(swe_2015$kin_summary)
- age <- as.integer(rownames(U))
- years_data <- as.integer(colnames(U))
+kin <- function(p = NULL, f = NULL,
+ time_invariant = TRUE,
+ pi = NULL, n = NULL,
+ output_cohort = NULL, output_period = NULL, output_kin=NULL, output_age_focal = NULL,
+ birth_female = 1/2.04,
+ summary_kin = TRUE)
+ {
- if (lifecycle::is_present(stable)) {
- lifecycle::deprecate_warn("0.0.0.9000", "kin(stable)", details = "Used time_invariant")
- time_invariant <- stable
- }
+ # global vars
+ living<-dead<-age_kin<-age_focal<-cohort<-year<-total<-mean_age<-count_living<-sd_age<-count_dead<-mean_age_lost<-indicator<-value<-NULL
# kin to return
all_possible_kin <- c("coa", "cya", "d", "gd", "ggd", "ggm", "gm", "m", "nos", "nys", "oa", "ya", "os", "ys")
+ output_kin_asked <- output_kin
if(is.null(output_kin)){
output_kin <- all_possible_kin
}else{
+ if("s" %in% output_kin) output_kin <- c(output_kin, "os", "ys")
+ if("c" %in% output_kin) output_kin <- c(output_kin, "coa", "cya")
+ if("a" %in% output_kin) output_kin <- c(output_kin, "oa", "ya")
+ if("n" %in% output_kin) output_kin <- c(output_kin, "nos", "nys")
+ output_kin <- output_kin[!output_kin %in% c("s", "c", "a", "n")]
output_kin <- match.arg(tolower(output_kin), all_possible_kin, several.ok = TRUE)
}
- # if time dependent or not
+ # if is time dependent or not
+ age <- as.integer(rownames(p))
+ years_data <- as.integer(colnames(p))
if(time_invariant){
- if(!is.vector(U)) {
+ if(!is.vector(p)) {
output_period <- min(years_data)
- U <- U[,as.character(output_period)]
+ p <- p[,as.character(output_period)]
f <- f[,as.character(output_period)]
}
- kin_full <- kin_time_invariant(U = U, f = f,
+ kin_full <- kin_time_invariant(p = p, f = f, pi = pi,
output_kin = output_kin, birth_female = birth_female) %>%
dplyr::mutate(cohort = NA, year = NA)
}else{
if(!is.null(output_cohort) & !is.null(output_period)) stop("sorry, you can not select cohort and period. Choose one please")
- kin_full <- kin_time_variant(U = U, f = f, N = N, pi = pi,
+ kin_full <- kin_time_variant(p = p, f = f, pi = pi, n = n,
output_cohort = output_cohort, output_period = output_period,
output_kin = output_kin,
birth_female = birth_female)
message(paste0("Assuming stable population before ", min(years_data), "."))
}
- # reorder
- kin_full <- kin_full %>% dplyr::select(year, cohort, age_focal, kin, age_kin, living, dead)
+ # re-group if grouped type is asked
+ if(!is.null(output_kin_asked) & length(output_kin_asked)!=length(output_kin)){
+ if("s" %in% output_kin_asked) kin_full$kin[kin_full$kin %in% c("os", "ys")] <- "s"
+ if("c" %in% output_kin_asked) kin_full$kin[kin_full$kin %in% c("coa", "cya")] <- "c"
+ if("a" %in% output_kin_asked) kin_full$kin[kin_full$kin %in% c("oa", "ya")] <- "a"
+ if("n" %in% output_kin_asked) kin_full$kin[kin_full$kin %in% c("nos", "nys")] <- "n"
+ kin_full <- kin_full %>%
+ dplyr::summarise(living = sum(living), dead = sum(dead),
+ .by = c(kin, age_kin, age_focal, cohort, year))
+ }
- # summary
- # select period/cohort
+ # select period/cohort/age
+ if(!is.null(output_age_focal) & all(output_age_focal %in% 1:120)){
+ kin_full <- kin_full %>% dplyr::filter(age_focal %in% output_age_focal)
+ }
if(!is.null(output_cohort)){
agrupar <- "cohort"
} else if(!is.null(output_period)){
@@ -87,28 +112,35 @@ kin <- function(U = NULL, f = NULL,
agrupar_no_age_focal <- c("kin", agrupar)
agrupar <- c("age_focal", "kin", agrupar)
- kin_summary <- dplyr::bind_rows(
- kin_full %>%
- dplyr::rename(total=living) %>%
- dplyr::group_by(dplyr::across(dplyr::all_of(agrupar))) %>%
- dplyr::summarise(count_living = sum(total),
- mean_age = sum(total*age_kin)/sum(total),
- sd_age = (sum(total*age_kin^2)/sum(total)-mean_age^2)^.5) %>%
- tidyr::pivot_longer(count_living:sd_age, names_to = "indicator", "value"),
- kin_full %>%
- dplyr::rename(total=dead) %>%
- dplyr::group_by(dplyr::across(dplyr::all_of(agrupar))) %>%
- dplyr::summarise(count_dead = sum(total)) %>%
- dplyr::ungroup() %>%
- dplyr::group_by(dplyr::across(dplyr::all_of(agrupar_no_age_focal))) %>%
- dplyr::mutate(count_cum_dead = cumsum(count_dead),
- mean_age_lost = cumsum(count_dead * age_focal)/cumsum(count_dead)) %>%
- dplyr::ungroup() %>%
- tidyr::pivot_longer(count_dead:mean_age_lost, names_to = "indicator", "value")) %>%
+ # get summary indicators based on group variables. If it is asked
+ if(summary_kin){
+ kin_summary <- dplyr::bind_rows(
+ kin_full %>%
+ dplyr::rename(total=living) %>%
+ dplyr::group_by(dplyr::across(dplyr::all_of(agrupar))) %>%
+ dplyr::summarise(count_living = sum(total),
+ mean_age = sum(total*age_kin)/sum(total),
+ sd_age = (sum(total*age_kin^2)/sum(total)-mean_age^2)^.5) %>%
+ tidyr::pivot_longer(count_living:sd_age, names_to = "indicator", values_to = "value"),
+ kin_full %>%
+ dplyr::rename(total=dead) %>%
+ dplyr::group_by(dplyr::across(dplyr::all_of(agrupar))) %>%
+ dplyr::summarise(count_dead = sum(total)) %>%
+ dplyr::ungroup() %>%
+ dplyr::group_by(dplyr::across(dplyr::all_of(agrupar_no_age_focal))) %>%
+ dplyr::mutate(count_cum_dead = cumsum(count_dead),
+ mean_age_lost = cumsum(count_dead * age_focal)/cumsum(count_dead)) %>%
+ dplyr::ungroup() %>%
+ tidyr::pivot_longer(count_dead:mean_age_lost, names_to = "indicator", values_to = "value")) %>%
dplyr::ungroup() %>%
tidyr::pivot_wider(names_from = indicator, values_from = value)
# return
kin_out <- list(kin_full = kin_full, kin_summary = kin_summary)
+ }else{
+ # return
+ kin_out <- kin_full
+ }
+
return(kin_out)
}
diff --git a/R/kin2sex.R b/R/kin2sex.R
new file mode 100644
index 0000000..07dfa11
--- /dev/null
+++ b/R/kin2sex.R
@@ -0,0 +1,194 @@
+#' Estimate kin counts in a two-sex framework
+
+#' @description Implementation of two-sex matrix kinship model. This produces kin counts grouped by kin, age and sex of
+#' each relatives at each Focal´s age. For example, male cousins from aunts and uncles from different sibling's parents
+#' are grouped in one male count of cousins. Note that the output labels relative following female notation: the label `m`
+#' refers to either mothers or fathers, and column `sex_kin` determine the sex of the relative.
+#' @details See Caswell (2022) for details on formulas.
+#' @param pf numeric. A vector (atomic) or matrix with female probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).
+#' @param pm numeric. A vector (atomic) or matrix with male probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).
+#' @param ff numeric. Same as `pf` but for fertility rates.
+#' @param fm numeric. Same as `pm` but for fertility rates.
+#' @param time_invariant logical. Constant assumption for a given `year` rates. Default `TRUE`.
+#' @param sex_focal character. "f" for female or "m" for male.
+#' @param pif numeric. For using some specific age distribution of childbearing for mothers (same length as ages). Default `NULL`.
+#' @param pim numeric. For using some specific age distribution of childbearing for fathers (same length as ages). Default `NULL`.
+#' @param Hf numeric. A list where each list element (being the name of each list element the year) contains a matrix with cause-specific hazards for females with rows as causes and columns as ages, being the name of each col the age.
+#' @param Hm numeric. A list where each list element (being the name of each list element the year) contains a matrix with cause-specific hazards for males with rows as causes and columns as ages, being the name of each col the age.
+#' @param nf numeric. Only for `time_invariant = FALSE`. Same as `pf` but for population distribution (counts or `%`). Optional.
+#' @param nm numeric. Only for `time_invariant = FALSE`. Same as `pm` but for population distribution (counts or `%`). Optional.
+#' @param output_cohort integer. Vector of year cohorts for returning results. Should be within input data years range.
+#' @param output_period integer. Vector of period years for returning results. Should be within input data years range.
+#' @param output_kin character. kin types to return: "m" for mother, "d" for daughter,...
+#' @param output_age_focal integer. Vector of ages to select (and make faster the run).
+#' @param birth_female numeric. Female portion at birth. This multiplies `f` argument. If `f` is already for female offspring, this needs to be set as 1.
+#' @param summary_kin logical. Whether or not include `kin_summary` table (see output details). Default `TRUE`.
+#' @return A list with:
+#' \itemize{
+#' \item{kin_full}{ a data frame with year, cohort, Focal´s age, related ages and type of kin (for example `d` could be daughter or son depending `sex_kin`,
+#' `oa` is older aunts or uncles also depending `sex_kin` value, etc.), including living and dead kin at that age.}
+#' \item{kin_summary}{ a data frame with Focal´s age, related ages, sex and type of kin, with indicators obtained processing `kin_full`, grouping by cohort or period (depending on the given arguments):}
+#' {\itemize{
+#' \item{`count_living`}{: count of living kin at actual age of Focal}
+#' \item{`mean_age`}{: mean age of each type of living kin.}
+#' \item{`sd_age`}{: standard deviation of age of each type of living kin.}
+#' \item{`count_death`}{: count of dead kin at specific age of Focal.}
+#' \item{`count_cum_death`}{: cumulated count of dead kin until specific age of Focal.}
+#' \item{`mean_age_lost`}{: mean age where Focal lost her relative.}
+#' }
+#' }
+#' }
+#' @export
+#' @examples
+#' # Kin expected count by relative sex for a French female based on 2012 rates.
+#' fra_fert_f <- fra_asfr_sex[,"ff"]
+#' fra_fert_m <- fra_asfr_sex[,"fm"]
+#' fra_surv_f <- fra_surv_sex[,"pf"]
+#' fra_surv_m <- fra_surv_sex[,"pm"]
+#' fra_2012 <- kin2sex(fra_surv_f, fra_surv_m, fra_fert_f, fra_fert_m)
+#' head(fra_2012$kin_summary)
+#'
+# get kin ----------------------------------------------------------------
+kin2sex <- function(pf = NULL, pm = NULL, ff = NULL, fm = NULL,
+ time_invariant = TRUE,
+ sex_focal = "f",
+ birth_female = 1/2.04,
+ pif = NULL, pim = NULL,
+ nf = NULL, nm = NULL,
+ Hf = NULL, Hm = NULL,
+ output_cohort = NULL, output_period = NULL, output_kin=NULL,output_age_focal = NULL,
+ summary_kin = TRUE)
+ {
+
+ # global vars
+ living<-age_focal<-cohort<-year<-total<-mean_age<-count_living<-sd_age<-count_dead<-mean_age_lost<-indicator<-value<-sex_kin<-age_kin<-dead<-NULL
+ age <- as.integer(rownames(pf))
+ years_data <- as.integer(colnames(pf))
+
+ # kin to return
+ all_possible_kin <- c("coa", "cya", "d", "gd", "ggd", "ggm", "gm", "m", "nos", "nys", "oa", "ya", "os", "ys")
+ output_kin_asked <- output_kin
+ if(is.null(output_kin)){
+ output_kin <- all_possible_kin
+ }else{
+ if("s" %in% output_kin) output_kin <- c(output_kin, "os", "ys")
+ if("c" %in% output_kin) output_kin <- c(output_kin, "coa", "cya")
+ if("a" %in% output_kin) output_kin <- c(output_kin, "oa", "ya")
+ if("n" %in% output_kin) output_kin <- c(output_kin, "nos", "nys")
+ output_kin <- output_kin[!output_kin %in% c("s", "c", "a", "n")]
+ output_kin <- match.arg(tolower(output_kin), all_possible_kin, several.ok = TRUE)
+ }
+
+ # is cause of death specific or not
+ is_cod <- !is.null(Hf) & !is.null(Hm)
+
+ # if time dependent or not
+ if(time_invariant){
+ if(!is.vector(pf)) {
+ output_period <- min(years_data)
+ pf <- pf[,as.character(output_period)]
+ pm <- pm[,as.character(output_period)]
+ ff <- ff[,as.character(output_period)]
+ fm <- fm[,as.character(output_period)]
+ }
+ if(is_cod){
+ kin_full <- kin_time_invariant_2sex_cod(pf, pm, ff, fm,
+ sex_focal = sex_focal,
+ birth_female = birth_female,
+ pif = pif, pim = pim,
+ Hf = Hf, Hm = Hm,
+ output_kin = output_kin) %>%
+ dplyr::mutate(cohort = NA, year = NA)
+ }else{
+ kin_full <- kin_time_invariant_2sex(pf, pm, ff, fm,
+ sex_focal = sex_focal,
+ birth_female = birth_female,
+ pif = pif, pim = pim,
+ output_kin = output_kin) %>%
+ dplyr::mutate(cohort = NA, year = NA)
+ }
+
+ }else{
+ if(!is.null(output_cohort) & !is.null(output_period)) stop("sorry, you can not select cohort and period. Choose one please")
+ if(is_cod){
+ kin_full <- kin_time_variant_2sex_cod(pf = pf, pm = pm,
+ ff = ff, fm = fm,
+ sex_focal = sex_focal,
+ birth_female = birth_female,
+ pif = pif, pim = pim,
+ nf = nf, nm = nm,
+ Hf = Hf, Hm = Hm,
+ output_cohort = output_cohort, output_period = output_period,
+ output_kin = output_kin)
+ }else{
+ kin_full <- kin_time_variant_2sex(pf = pf, pm = pm,
+ ff = ff, fm = fm,
+ sex_focal = sex_focal,
+ birth_female = birth_female,
+ pif = pif, pim = pim,
+ nf = nf, nm = nm,
+ output_cohort = output_cohort, output_period = output_period,
+ output_kin = output_kin)
+ }
+ message(paste0("Assuming stable population before ", min(years_data), "."))
+ }
+
+ # reorder
+ kin_full <- kin_full %>% dplyr::select(year, cohort, age_focal, sex_kin, kin, age_kin, living, starts_with("dea"))
+
+ # re-group if grouped type is asked
+ if(!is.null(output_kin_asked) & length(output_kin_asked)!=length(output_kin)){
+ if("s" %in% output_kin_asked) kin_full$kin[kin_full$kin %in% c("os", "ys")] <- "s"
+ if("c" %in% output_kin_asked) kin_full$kin[kin_full$kin %in% c("coa", "cya")] <- "c"
+ if("a" %in% output_kin_asked) kin_full$kin[kin_full$kin %in% c("oa", "ya")] <- "a"
+ if("n" %in% output_kin_asked) kin_full$kin[kin_full$kin %in% c("nos", "nys")] <- "n"
+ kin_full <- kin_full %>%
+ dplyr::group_by(kin, age_kin, age_focal, sex_kin, cohort, year) %>%
+ dplyr::summarise_at(vars(c("living", dplyr::starts_with("dea"))), funs(sum)) %>%
+ dplyr::ungroup()
+ }
+
+ # summary
+ # select period/cohort/ge
+ if(!is.null(output_age_focal) & all(output_age_focal %in% 1:120)){
+ kin_full <- kin_full %>% dplyr::filter(age_focal %in% output_age_focal)
+ }
+ if(!is.null(output_cohort)){
+ agrupar <- "cohort"
+ } else if(!is.null(output_period)){
+ agrupar <- "year"
+ } else{
+ agrupar <- c("year", "cohort")
+ }
+ agrupar_no_age_focal <- c("kin", "sex_kin", agrupar)
+ agrupar <- c("age_focal", "kin", "sex_kin", agrupar)
+
+ # only return summary if is asked and is not cod
+ if(summary_kin & !is_cod){
+ kin_summary <- dplyr::bind_rows(
+ as.data.frame(kin_full) %>%
+ dplyr::rename(total=living) %>%
+ dplyr::group_by(dplyr::across(dplyr::all_of(agrupar))) %>%
+ dplyr::summarise(count_living = sum(total),
+ mean_age = sum(total*age_kin)/sum(total),
+ sd_age = (sum(total*age_kin^2)/sum(total)-mean_age^2)^.5) %>%
+ tidyr::pivot_longer(count_living:sd_age, names_to = "indicator", values_to = "value"),
+ as.data.frame(kin_full) %>%
+ dplyr::rename(total=dead) %>%
+ dplyr::group_by(dplyr::across(dplyr::all_of(agrupar))) %>%
+ dplyr::summarise(count_dead = sum(total)) %>%
+ dplyr::ungroup() %>%
+ dplyr::group_by(dplyr::across(dplyr::all_of(agrupar_no_age_focal))) %>%
+ dplyr::mutate(count_cum_dead = cumsum(count_dead),
+ mean_age_lost = cumsum(count_dead * age_focal)/cumsum(count_dead)) %>%
+ dplyr::ungroup() %>%
+ tidyr::pivot_longer(count_dead:mean_age_lost, names_to = "indicator", values_to = "value")) %>%
+ dplyr::ungroup() %>%
+ tidyr::pivot_wider(names_from = indicator, values_from = value)
+ kin_out <- list(kin_full = kin_full, kin_summary = kin_summary)
+ }else{
+ kin_out <- kin_full
+ }
+
+ return(kin_out)
+}
diff --git a/R/kin_multi_stage.R b/R/kin_multi_stage.R
index 7129134..829b232 100644
--- a/R/kin_multi_stage.R
+++ b/R/kin_multi_stage.R
@@ -2,110 +2,126 @@
#' @description Implementation of age-stage kin estimates (multi-state) by Caswell (2020). Stages are implied in length of input lists.
-#' @param U list. age elemnts with column-stochastic transition matrix with dimension for the state space, conditional on survival.
-#' @param f matrix. state-specific fertility (age in rows and states in columns).
-#' @param D matrix. survival probabilities by state (age in rows and states in columns)
-#' @param H matrix. assigns the offspring of individuals in some stage to the appropriate age class with 1 (age in rows and states in columns).
+#' @param U list. age elements with column-stochastic transition matrix with dimension for the state space, conditional on survival.
+#' @param f matrix. state-specific fertility (age in rows and states in columns). Is accepted also a list with for each age-class.
+#' @param D matrix. survival probabilities by state (age in rows and states in columns). Is accepted also a list for each state with survival matrices.
+#' @param H matrix. assigns the offspring of individuals in some stage to the appropriate age class (age in rows and states in columns). Is accepted also a list with a matrix for each state.
#' @param output_kin character. kin to return. For example "m" for mother, "d" for daughter. See the `vignette` for all kin types.
#' @param birth_female numeric. Female portion at birth.
+#' @param parity logical. parity states imply age distribution of mothers re-scaled to not have parity 0 when Focal born. Default `TRUE`.
#' @param list_output logical. Results as a list. Default `FALSE`.
#' @return A data frame with focal´s age, related ages and type of kin
#' (for example `d` is daughter, `oa` is older aunts, etc.), living and death kin counts, and specific stage. If `list_output = TRUE` then this is a list with elements as kin types.
#' @export
-#'
kin_multi_stage <- function(U = NULL, f = NULL, D = NULL, H = NULL,
- birth_female = 1/2.04,
- output_kin = NULL,
- list_output = FALSE){
+ birth_female = 1/2.04,
+ output_kin = NULL,
+ parity = FALSE,
+ list_output = FALSE){
+ # global vars
+ .<-age_kin<-stage_kin<-alive<-age_focal<-count<-NULL
+
+ # mandatory U as a list
if(!is.list(U)) stop("U must be a list with age length of elements, and stage transitiotn matrix for each one.")
- # stages and ages
+ # stages and age-classes
s <- ncol(U[[1]])
ages <- length(U)
age <- (1:ages)-1
- # build matrix structure from data.frame input
- H <- purrr::map(colnames(D), function(Y){
- Ht = matrix(0, nrow=ages, ncol=ages)
- Ht[1,] <- 1
- Ht
- })
- D <- purrr::map(colnames(D), function(Y){
+ # build H if it is not already a list
+ if(!is.list(H)){
+ H <- purrr::map(1:s, function(Y){
+ Ht = matrix(0, nrow=ages, ncol=ages)
+ Ht[1,] <- 1
+ Ht
+ })
+ }
+
+ # build D if it is not already a list
+ if(!is.list(D)){
+ D <- purrr::map(1:s, function(Y){
X <- D[,Y]
Dt = matrix(0, nrow=ages, ncol=ages)
Dt[row(Dt)-1 == col(Dt)] <- X[-ages]
Dt[ages, ages] = X[ages]
Dt
})
- f <- purrr::map(1:ages, function(Y){
- X <- f[Y,]
- ft = matrix(0, nrow=s, ncol=s)
- ft[1,] <- X
- ft
- })
-
- # build block matrix
+ }
+
+ # build f if it is not already a list
+ if(!is.list(f)){
+ f <- purrr::map(1:ages, function(Y){
+ X <- f[Y,]
+ ft = matrix(0, nrow=s, ncol=s)
+ ft[1,] <- X
+ ft
+ })
+ }
+
+ # build block matrices
bbU <- Matrix::bdiag(U)
bbF <- Matrix::bdiag(f) * birth_female
bbD <- Matrix::bdiag(D)
bbH <- Matrix::bdiag(H)
- # rearrange with conmutation matrix
+ # order transitions: first state within age, then age given state
K <- matrixcalc::commutation.matrix(s, ages)
Ut <- t(K) %*% bbD %*% K %*% bbU
ft <- t(K) %*% bbH %*% K %*% bbF
+
+ # focal transition but conditioned to survive
Gt <- Ut%*% MASS::ginv(diag(colSums(as.matrix(Ut))))
- # stable distribution mothers: age x stage
+ # stable distribution of mothers
At <- Ut + ft
A_decomp <- eigen(At)
lambda <- as.double(A_decomp$values[1])
wt <- as.double(A_decomp$vectors[,1])/sum(as.double(A_decomp$vectors[,1]))
pi <- wt*At[1,]/sum(wt*At[1,])
- # marginal mothers age
- Iom <- diag(1,ages, ages);
- ones <- t(rep(1,s))
+ # useful vectors and matrices
+ ones <- t(rep(1,s))
onesom <- t(rep(1,s*ages))
- piage <- kronecker(Iom,ones) %*% pi
-
- # momarray is an array with pit in each column
- momarray <- pi %*% matrix(1,1,ages)
- Iom = diag(1, ages)
- Is = diag(1, s)
- Isom = diag(1, s*ages)
- zsom = matrix(0, s*ages, s*ages)
- Z=Is;
- Z[1,1]=0;
- for(i in 1:ages){
- # imom = 1
- E <- Iom[,i] %*% t(Iom[i,]); # al cuadrado?
- momarray[,i] <- kronecker(E,Z) %*% momarray[,i]
- }
- # re-scale
- momarray <- momarray %*% MASS::ginv(diag(colSums(momarray)))
-
- # considering deaths
- phi = d = gd = ggd = m = gm = ggm = os = ys = nos = nys = oa = ya = coa = cya = matrix(0,ages*s*2,ages)
- phi[1,1] = 1
+ onesa <- t(rep(1,ages))
+ Iom <- diag(1, ages)
+ Is <- diag(1, s)
+ Isom <- diag(1, s*ages)
+ zsom <- matrix(0, s*ages, s*ages)
+
+ # momarray is an array with pi in each column
+ piage <- kronecker(Iom,ones) %*% pi
+ momarray <- pi %*% onesa
+
+ # considering deaths (no cumulated): reacreate block struct matrices
+ phi = d = gd = ggd = m = gm = ggm = os = ys = nos = nys = oa = ya = coa = cya = matrix(0,ages * s * 2, ages)
Mtt <- diag(as.numeric(onesom - onesom %*% Ut))
Utt <- rbind(cbind(Ut,zsom), cbind(Mtt,Isom)) %>% as.matrix()
ftt <- rbind(cbind(ft,zsom), cbind(zsom,zsom)) %>% as.matrix()
Gtt <- rbind(cbind(Gt,zsom), cbind(zsom,zsom)) %>% as.matrix()
sages <- 1:(ages*s)
- # no considering deaths
- # phi = d = gd = ggd = m = gm = ggm = os = ys = nos = nys = oa = ya = coa = cya = matrix(0,ages*s,ages)
- # phi[1,1] = 1
- # Utt = Ut %>% as.matrix()
- # ftt = ft %>% as.matrix()
- # Gtt = Gt %>% as.matrix()
+ # if parity: restriction to no initial mothers with 0 parity
+ if(parity){
+ Z=Is
+ Z[1,1]=0
+ for(i in 1:ages){
+ E <- Iom[,i] %*% t(Iom[i,])
+ momarray[,i] <- kronecker(E,Z) %*% momarray[,i]
+ }
+ # re-scale
+ momarray <- momarray %*% MASS::ginv(diag(colSums(momarray)))
+ # no 0 parity mothers: (momarray %*% piage)[seq(1,600,6)]
+ m[sages,1] = momarray %*% piage
+ }else{
+ m[sages,1] = pi
+ }
# focal´s trip
- m[sages,1] = momarray %*% piage;
+ phi[1,1] = 1
for(i in 1:(ages-1)){
phi[,i+1] = Gtt %*% phi[,i]
d[,i+1] = Utt %*% d[,i] + ftt %*% phi[,i]
@@ -145,7 +161,8 @@ kin_multi_stage <- function(U = NULL, f = NULL, D = NULL, H = NULL,
}
# get results
- kin_list <- list(d=d,gd=gd,ggd=ggd,m=m,gm=gm,ggm=ggm,os=os,ys=ys,
+ kin_list <- list(focal = phi,
+ d=d,gd=gd,ggd=ggd,m=m,gm=gm,ggm=ggm,os=os,ys=ys,
nos=nos,nys=nys,oa=oa,ya=ya,coa=coa,cya=cya)
# only selected kin
@@ -153,34 +170,32 @@ kin_multi_stage <- function(U = NULL, f = NULL, D = NULL, H = NULL,
kin_list <- kin_list %>% purrr::keep(names(.) %in% output_kin)
}
- # as data.frame
- kin <- purrr::map2(kin_list, names(kin_list),
- function(x,y){
- out <- as.data.frame(x)
- colnames(out) <- age
- out %>%
- dplyr::mutate(kin = y,
- age_kin = rep(sort(rep(age,s)),2),
- stage_kin = rep(rep(1:s,ages),2),
- alive = c(rep("living",s*ages),rep("dead",s*ages))
- # age_kin = sort(rep(age,s)),
- # stage_kin = rep(1:s,ages),
- # alive = c(rep("yes",s*ages))
- ) %>%
- tidyr::pivot_longer(c(-age_kin, -stage_kin, -kin, -alive), names_to = "age_focal", values_to = "count") %>%
- dplyr::mutate(age_focal = as.integer(age_focal)) %>%
- tidyr::pivot_wider(names_from = alive, values_from = count)
- }) %>%
+ # kin_full as data.frame
+ kin_full <- purrr::map2(kin_list, names(kin_list),
+ function(x,y){
+ # reassign deaths to Focal experienced age
+ x[(ages*s+1):(ages*s*2),1:(ages-1)] <- x[(ages*s+1):(ages*s*2),2:ages]
+ x[(ages*s+1):(ages*s*2),ages] <- 0
+ out <- as.data.frame(x)
+ colnames(out) <- age
+ out %>%
+ dplyr::mutate(kin = y,
+ age_kin = rep(sort(rep(age,s)),2),
+ stage_kin = rep(rep(1:s,ages),2),
+ alive = c(rep("living",s*ages),rep("dead",s*ages))) %>%
+ tidyr::pivot_longer(c(-age_kin, -stage_kin, -kin, -alive), names_to = "age_focal", values_to = "count") %>%
+ dplyr::mutate(age_focal = as.integer(age_focal)) %>%
+ tidyr::pivot_wider(names_from = alive, values_from = count)
+ }) %>%
purrr::reduce(rbind)
# results as list?
if(list_output) {
out <- kin_list
}else{
- out <- kin
+ out <- kin_full
}
+ # end
return(out)
}
-
-
diff --git a/R/kin_multi_stage_time_variant_2sex.R b/R/kin_multi_stage_time_variant_2sex.R
new file mode 100644
index 0000000..6b51be4
--- /dev/null
+++ b/R/kin_multi_stage_time_variant_2sex.R
@@ -0,0 +1,1061 @@
+
+#' Estimate kin counts by age, stage, and sex, in a time variant framework
+
+#' @description Implementation of combined formal demographic models: Caswell II,III,IV.
+
+#' @param U_list_females list with matrix entries: period-specific female survival probabilities. Age in rows and states in columns.
+#' @param U_list_males list with matrix entries: period-specific male survival probabilities. Age in rows and states in columns.
+#' @param F_list_females list with matrix with elements: period-specific female fertility (age in rows and states in columns).
+#' @param F_list_males list with matrix entries: period-specific male fertility (age in rows and states in columns).
+#' @param T_list_females list of lists with matrix entries: each outer list entry is period-specific, and composed of
+#' a list of stochastic matrices which describe age-specific female probabilities of transferring stage
+#' @param T_list_males list of lists with matrix entries: each outer list entry is period-specific, and composed of
+#' a list of stochastic matrices which describe age-specific male probabilities of transferring stage
+#' @param H_list list with matrix entries: redistribution of newborns across each stage to a specific age-class
+#' @param birth_female numeric. birth ratio of females to males in population
+#' @param parity logical. parity states imply age distribution of mothers re-scaled to not have parity 0 when Focal born. Default `TRUE`.
+#' @param output_kin vector. A vector of particular kin one wishes to obtain results for, e.g., c("m","d","oa"). Default is all kin types.
+#' @param summary_kin logical. Results as a data frame of accumulated kin by age of Focal if TRUE, and kin by their age*stage distribution by age of Focal if FALSE.
+#' @param sex_Focal character. Female or Male as the user requests.
+#' @param initial_stage_Focal Numeric in Natural number set {1,2,...,}. The stage which Focal is born into (e.g., 1 for parity 0)
+#' @param output_years vector. The times at which we wish to count kin: start year = output_years[1], and end year = output_years[length.]
+#'
+#' @return A data frame with focal age, kin age, kin stage, kin sex, year, cohort, and expected number of kin given these restrictions.
+
+#' @export
+#'
+kin_multi_stage_time_variant_2sex <- function(U_list_females = NULL,
+ U_list_males = NULL,
+ F_list_females = NULL,
+ F_list_males = NULL,
+ T_list_females = NULL,
+ T_list_males = NULL,
+ H_list = NULL,
+ birth_female = 0.49, ## Sex ratio -- note is 1 - alpha
+ parity = FALSE,
+ output_kin = NULL, # enter a vector of specific kin if we only want to analyse these (e.g., c("m","d"))
+ summary_kin = TRUE, # Set to FALSE if we want only a full age*stage distribution of kin
+ sex_Focal = "Female", # Female Focal is default
+ initial_stage_Focal = NULL,
+ output_years){
+
+ no_years <- length(U_list_females)
+ na <- nrow(U_list_females[[1]])
+ ns <- ncol(U_list_females[[1]])
+
+ # Ensure inputs are lists of matrices and that the timescale same length
+ # if(length(U_list_females)!=length(output_years)){stop("Timescale inconsistancy")} ## this is due to my struggles with counting! ( e.g., seq(10, 20, 1) != list(1 : 10) )
+ if(!is.list(U_list_females) | !is.list(U_list_males)){stop("U's must be a list with time-series length. Each list entry should be an age*stage dimensional matrix")}
+ if(!is.list(F_list_females) | !is.list(F_list_males)){stop("F's must be a list with time-series length. Each list entry should be an age*stage dimensional matrix")}
+ if(!is.list(T_list_females) | !is.list(T_list_males)){stop("T's must be a list with time-series length. Each list entry should be an age*stage dimensional matrix")}
+
+ ### Define empty lists for the accumulated kin of Focals's life-course -- each list entry will reflect a time-period
+ changing_pop_struct <- list()
+ Focal_array <- list()
+ mom_array <- list()
+ gran_array <- list()
+ great_gran_array <- list()
+ daughter_array <- list()
+ younger_sis_array <- list()
+ grand_daughter_array <-list()
+ great_grand_daughter_array <- list()
+ older_sister_array <- list()
+ younger_aunt_array <- list()
+ older_aunt_array <- list()
+ younger_niece_array <- list()
+ older_niece_array <- list()
+ younger_cousin_array <- list()
+ older_cousin_array <- list()
+
+ ### At each time-period we: 1) -- construct the time-variant projection matrices:
+ ### U_tilde : transfers across stage and advances age
+ ### F_tilde : makes newborns from stage/age; puts them to stage/age
+ ### 2) -- project Focal and kin using above projection matrices
+
+ pb <- progress::progress_bar$new(
+ format = "Timescale [:bar] :percent",
+ total = no_years + 1, clear = FALSE, width = 60)
+ tictoc::tic()
+ for(year in 1:no_years){
+ T_data_f <- T_list_females[[year]] ## For each year we have na number of Transfer matrices
+ T_data_m <- T_list_males[[year]] ## which give probabilities of age-dep movement from stage to stage
+ T_f_list <- list()
+ T_m_list <- list()
+ F_f_list <- list()
+ F_m_list <- list()
+ U_f_list <- list()
+ U_m_list <- list()
+ H_list2 <- list()
+
+ for(stage in 1:ns){
+ Uf <- Matrix::Matrix(nrow = na, ncol = na, data = 0, sparse = TRUE)
+ Matrix::diag(Uf[-1,-ncol(Uf)]) <- U_list_females[[year]][1:(na-1),stage]
+ Uf[na,na] <- U_list_females[[year]][na,stage]
+ Um <- Matrix::Matrix(nrow = na, ncol = na, data = 0, sparse = TRUE)
+ Matrix::diag(Um[-1,-ncol(Um)]) <- U_list_males[[year]][1:(na-1),stage]
+ Um[na,na] <- U_list_males[[year]][na,stage]
+ U_f_list[[(1+length(U_f_list))]] <- Uf
+ U_m_list[[(1+length(U_m_list))]] <- Um
+ H_mat <- Matrix::Matrix(nrow = na, ncol = na, data = 0, sparse = TRUE)
+ H_mat[1,] <- 1
+ H_list2[[(1+length(H_list2))]] <- H_mat
+ }
+ for(age in 1:na){
+ T_f <- T_data_f[[age]]
+ T_m <- T_data_m[[age]]
+ T_f_list[[(1+length(T_f_list))]] <- T_f
+ T_m_list[[(1+length(T_m_list))]] <- T_m
+ F_f <- Matrix::Matrix(nrow = ns, ncol = ns, data = 0, sparse = TRUE)
+ F_m <- Matrix::Matrix(nrow = ns, ncol = ns, data = 0, sparse = TRUE)
+ F_f[1,] <- F_list_females[[year]][age,]
+ F_m[1,] <- F_list_males[[year]][age,]
+ F_f_list[[(1+length(F_f_list))]] <- F_f
+ F_m_list[[(1+length(F_m_list))]] <- F_m
+ }
+ ## create the appropriate block-diagonal matrices
+ U_f_BDD <- block_diag_function(U_f_list) ## direct sum of female survivorship, independent over stage (ns diagonal blocks)
+ U_m_BDD <- block_diag_function(U_m_list) ## direct sum of male survivorship, independent over stage (ns diagonal blocks)
+ H_BDD <- block_diag_function(H_list2) ## direct sum of which age newborns enter, independent over stage (ns diagonal blocks)
+ T_f_BDD <- block_diag_function(T_f_list) ## direct sum of female stage transitions, independent over age (na diagonal blocks)
+ T_m_BDD <- block_diag_function(T_m_list) ## direct sum of male stage transitions, independent over age (na diagonal blocks)
+ F_f_BDD <- block_diag_function(F_f_list) ## direct sum of female stage->stage reproductions, independent over age (na blocks)
+ F_m_BDD <- block_diag_function(F_m_list) ## direct sum of male stage->stage reproductions, independent over age (na blocks)
+
+ ## create the appropriate projection matrices
+ U_tilde_females <- Matrix::t(K_perm_mat(ns, na)) %*%
+ U_f_BDD %*%
+ K_perm_mat(ns, na) %*%
+ T_f_BDD
+
+ ## create sex-specific age*stage projections
+ U_tilde_males <- Matrix::t(K_perm_mat(ns, na)) %*%
+ U_m_BDD %*%
+ K_perm_mat(ns, na) %*%
+ T_m_BDD
+
+ F_tilde_females <- Matrix::t(K_perm_mat(ns, na)) %*%
+ H_BDD %*%
+ K_perm_mat(ns, na) %*%
+ F_f_BDD
+
+ F_tilde_males <- Matrix::t(K_perm_mat(ns, na)) %*%
+ H_BDD %*%
+ K_perm_mat(ns, na) %*%
+ F_m_BDD
+
+ ## if year == 1 we are at the boundary condition t=0 apply time-invariant kinship projections
+ if(year == 1){
+ ## Output of the static model
+ kin_out_1 <- all_kin_dy(U_tilde_females,
+ U_tilde_males ,
+ F_tilde_females,
+ F_tilde_males,
+ 1-birth_female,
+ na,
+ ns,
+ parity,
+ sex_Focal,
+ initial_stage_Focal)
+ ### Relative lists' first entries
+ Focal_array[[(1+length(Focal_array))]] <- kin_out_1[["Focal"]]
+ daughter_array[[(1+length(daughter_array))]] <- kin_out_1[["d"]]
+ grand_daughter_array[[(1+length(grand_daughter_array))]] <- kin_out_1[["gd"]]
+ great_grand_daughter_array[[(1+length(great_grand_daughter_array))]] <- kin_out_1[["ggd"]]
+ mom_array[[(1+length(mom_array))]] <- kin_out_1[["m"]]
+ gran_array[[(1+length(gran_array))]] <- kin_out_1[["gm"]]
+ great_gran_array[[(1+length(great_gran_array))]] <- kin_out_1[["ggm"]]
+ younger_sis_array[[( 1+length(younger_sis_array))]] <- kin_out_1[["ys"]]
+ older_sister_array[[(1+length(older_sister_array))]] <- kin_out_1[["os"]]
+ younger_aunt_array[[(1+length(younger_aunt_array))]] <- kin_out_1[["ya"]]
+ older_aunt_array[[(1+length(older_aunt_array))]] <- kin_out_1[["oa"]]
+ younger_niece_array[[(1+length(younger_niece_array))]] <- kin_out_1[["nys"]]
+ older_niece_array[[(1+length(older_niece_array))]] <- kin_out_1[["nos"]]
+ younger_cousin_array[[(1+length(younger_cousin_array))]] <- kin_out_1[["cya"]]
+ older_cousin_array[[(1+length(older_cousin_array))]] <- kin_out_1[["coa"]]
+ changing_pop_struct[[(1+length(changing_pop_struct))]] <- kin_out_1[["ps"]]
+
+ }
+ updating_Focal <- Focal_array[[year]]
+ updating_daughter <- daughter_array[[year]]
+ updating_grand_daughter <- grand_daughter_array[[year]]
+ updating_great_grand_daughter <- great_grand_daughter_array[[year]]
+ updating_mom <- mom_array[[year]]
+ updating_gran <- gran_array[[year]]
+ updating_great_gran <- great_gran_array[[year]]
+ updating_younger_sis <- younger_sis_array[[year]]
+ updating_older_sis <- older_sister_array[[year]]
+ updating_youner_aunt <- younger_aunt_array[[year]]
+ updating_older_aunt <- older_aunt_array[[year]]
+ updating_younger_niece <- younger_niece_array[[year]]
+ updating_older_niece <- older_niece_array[[year]]
+ updating_younger_cousin <- younger_cousin_array[[year]]
+ updating_older_cousin <- older_cousin_array[[year]]
+ updating_pop_struct <- changing_pop_struct[[year]]
+
+ ## Output of the time-variant model
+ kin_out <- all_kin_dy_TV(U_tilde_females,
+ U_tilde_males,
+ F_tilde_females,
+ F_tilde_males,
+ 1-birth_female,
+ na,
+ ns,
+ parity,
+ sex_Focal,
+ initial_stage_Focal,
+ updating_Focal,
+ updating_daughter,
+ updating_grand_daughter,
+ updating_great_grand_daughter,
+ updating_mom,
+ updating_gran,
+ updating_great_gran,
+ updating_older_sis,
+ updating_younger_sis,
+ updating_older_niece,
+ updating_younger_niece,
+ updating_older_aunt,
+ updating_youner_aunt,
+ updating_older_cousin,
+ updating_younger_cousin,
+ updating_pop_struct)
+ ## Relative lists entries correspond to timescale periods (each entry an kin age*stage*2 by Focal age matrix)
+ Focal_array[[(1+length(Focal_array))]] <- kin_out[["Focal"]]
+ daughter_array[[(1+length(daughter_array))]] <- kin_out[["d"]]
+ grand_daughter_array[[(1+length(grand_daughter_array))]] <- kin_out[["gd"]]
+ great_grand_daughter_array[[(1+length(great_grand_daughter_array))]] <- kin_out[["ggd"]]
+ mom_array[[(1+length(mom_array))]] <- kin_out[["m"]]
+ gran_array[[(1+length(gran_array))]] <- kin_out[["gm"]]
+ great_gran_array[[(1+length(great_gran_array))]] <- kin_out[["ggm"]]
+ younger_sis_array[[(1+length(younger_sis_array))]] <- kin_out[["ys"]]
+ older_sister_array[[(1+length(older_sister_array))]] <- kin_out[["os"]]
+ younger_aunt_array[[(1+length(younger_aunt_array))]] <- kin_out[["ya"]]
+ older_aunt_array[[(1+length(older_aunt_array))]] <- kin_out[["oa"]]
+ younger_niece_array[[(1+length(younger_niece_array))]] <- kin_out[["nys"]]
+ older_niece_array[[(1+length(older_niece_array))]] <- kin_out[["nos"]]
+ younger_cousin_array[[(1+length(younger_cousin_array))]] <- kin_out[["cya"]]
+ older_cousin_array[[(1+length(older_cousin_array))]] <- kin_out[["coa"]]
+ changing_pop_struct[[(1+length(changing_pop_struct))]] <- kin_out[["ps"]]
+ pb$tick()
+ }
+ tictoc::toc()
+ ## create a list of output kin -- each element a time-period specific list of matrices
+ ## label the kin names to match DemoKin:
+ relative_data <- list("Focal" = Focal_array,
+ "d" = daughter_array,
+ "gd" = grand_daughter_array,
+ "ggd" = great_grand_daughter_array,
+ "m" = mom_array,
+ "gm" = gran_array,
+ "ggm" = great_gran_array,
+ "ys" = younger_sis_array,
+ "os" = older_sister_array,
+ "ya" = younger_aunt_array,
+ "oa" = older_aunt_array,
+ "nys" = younger_niece_array,
+ "nos" = older_niece_array,
+ "cya" = younger_cousin_array,
+ "coa" = older_cousin_array)
+
+ relative_names <- names(relative_data)
+ ## create a nice data frame output
+ kin_full <- create_full_dists_df(relative_data,
+ relative_names,
+ output_years,
+ output_years[1],
+ na,
+ ns,
+ output_kin)
+ if(summary_kin){
+ kin_summary <- create_cumsum_df(relative_data,
+ relative_names,
+ output_years,
+ output_years[1],
+ na,
+ ns,
+ output_kin)
+ kin_out <- list(kin_full = kin_full, kin_summary = kin_summary)}
+ else{
+ kin_out <- kin_full
+ }
+ return(kin_out)
+}
+
+
+#' Title time invariant two-sex multi-state kin projections
+#'
+#' @param Uf matrix (block structured). transfers female individuals across stages and advances their age (conditional on survial)
+#' @param Um matrix (block structured). transfers male individuals across stages and advances their age (conditional on survial)
+#' @param Ff matrix (block structured). accounts for female reproduction, and assigns newborns into given age*stage
+#' @param Fm matrix (block structured). accounts for male reproduction; assigns newborns into age-class, and stage
+#' @param alpha scalar. birth ratio (male:female)
+#' @param na scalar. number of ages.
+#' @param ns scalar. number of stages.
+#' @param Parity logical. If true then we omit mothers of parity 0, and re-scale the mother's age*stage of parenting
+#' @param sex_Focal logical. Female or Male
+#' @param Initial_stage_Focal numeric. Any natural number {1,2,3,4,...}
+#'
+#' @return a list of matrices. Each list entry represents a particular kin. Each kin is chacacterised by a matrix of dimension:
+#' nrow = 2* na * ns (2-sex age-stage structured) and ncol = na (Focal's age)
+#' yielding the age*stage distribution of kin for each age of Focal
+
+all_kin_dy <- function(Uf,
+ Um,
+ Ff,
+ Fm,
+ alpha, ## alpha = sex ratio male:female (i.e., 1 - birth_female)
+ na, ## na = number of ages
+ ns, ## ns = number of stages
+ Parity,
+ sex_Focal, ## binary "F" or "M"
+ Initial_stage_Focal){
+
+ n <- nrow(Uf) ## number of ages * stages for each sex
+
+ ## Projection matrices:
+
+ ## Uproj is a block diagonal matrix of block-structured Age*Stage matrices; independently over sex transfers individuals across stage and up age
+ Uproj <- Matrix::Matrix(block_diag_function(list(Uf, Um)), sparse = TRUE)
+ ## Fproj is a Sex-block-structured matrix of block-structured Age*Stage matrices where males and females BOTH reproduce (by stage)
+ Fproj <- Matrix::Matrix(nrow = (2*n), ncol = (2*n), data = 0, sparse = TRUE)
+ Fproj[1:n, 1:n] <- (1-alpha)*Ff ## Ff is Age*Stage block structured giving rate at which females in age-stage produce individuals in age-stage
+ Fproj[(n+1):(2*n), 1:n] <- alpha*Ff
+ Fproj[1:n, (n+1):(2*n)] <- (1-alpha)*Fm ## Fm is Age*Stage block structured giving rate at which males in age-stage produce individuals in age-stage
+ Fproj[(n+1):(2*n), (n+1):(2*n)] <- alpha*Fm
+
+ ## Fprojstar is a Sex-block-structured matrix of block-structured Age*Stage matrices where ONLY females reproduce
+ Fprojstar <- Matrix::Matrix(nrow = (2*n), ncol = (2*n), data = 0, sparse = TRUE) ## Block structured F_tilde
+ Fprojstar[1:n, 1:n] <- (1-alpha)*Ff
+ Fprojstar[(n+1):(2*n), 1:n] <- alpha*Ff
+
+ ## The stable population structure is an age*stage*sex vector:
+ ## 1:n gives the female age*stage structure
+ ## (1+n):2n gives the male age*stage structure
+ population_age_stage_structure <- SD(Uproj + Fprojstar)
+
+ ### Stable distribution of mothers needs adjusting if we work with parity
+ if(Parity){
+ Initial_stage_Focal <- 1
+
+ population_age_stage_of_parenting <- pi_mix_parity(Uf, Um, Ff, Fm, alpha, na, ns)
+
+ parents_joint_age_stage <- population_age_stage_of_parenting[[1]]
+
+ mothers_age_stage <- population_age_stage_of_parenting[[2]]
+ fathers_age_stage <- population_age_stage_of_parenting[[3]]
+
+ mothers_age_dist <- population_age_stage_of_parenting[[4]]
+ fathers_age_dist <- population_age_stage_of_parenting[[5]]
+
+ }
+ else{
+ population_age_stage_of_parenting <- pi_mix(Uf, Um, Ff, Fm, alpha, na, ns)
+
+ parents_joint_age_stage <- population_age_stage_of_parenting[[1]]
+
+ mothers_age_stage <- population_age_stage_of_parenting[[2]]
+ fathers_age_stage <- population_age_stage_of_parenting[[3]]
+
+ mothers_age_dist <- population_age_stage_of_parenting[[4]]
+ fathers_age_dist <- population_age_stage_of_parenting[[5]]
+
+ }
+
+ ####################################### The dynamics of Kinship, starting with Focal who is no longer a unit vector
+
+ ### Focal requires its own dynamic: G_tilde constructed below tracks Focal's age*stage advancement over the time-scale
+ f_t <- get_G(Uf, na, ns) ## get_G function in "Functions_required.R"
+ m_t <- get_G(Um, na, ns)
+ G_tilde <- block_diag_function(list(f_t,m_t))
+ X_Focal <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ IC_Focal <- rep(0, 2*n)
+ if(sex_Focal == "Female"){
+ entry <- 1 + (Initial_stage_Focal-1)*na
+ IC_Focal[entry] <- 1}
+ else{
+ entry <- n + 1 + (Initial_stage_Focal-1)*na
+ IC_Focal[entry] <- 1
+ }
+
+ ### empty kin matrices for all of Focal's kin
+ X_children <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_grand_children <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_great_grand_children <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_parents <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_grand_parents <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_great_grand_parents <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_older_sibs <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_younger_sibs <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_older_niece_nephew <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_younger_niece_nephew <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_older_aunt_uncle <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_younger_aunts_uncles <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_older_cousins <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_younger_cousins <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+
+
+ ### Initial distributions for kin with non-zero deterministic initial conditions:
+ # Focal, parents, children, grand+great children, younger siblings, and younger nieces/nehpews
+ X_Focal[,1] <- IC_Focal
+ X_parents[, 1] <- parents_joint_age_stage
+
+ ### projection all kin with deterministic initial conditions
+ for(i in 1 : (na-1)){
+ X_Focal[,i+1] <- G_tilde %*% X_Focal[,i]
+ X_parents[, i+1] <- Uproj %*% X_parents[, i]
+ X_younger_sibs[,i+1] <- Uproj %*% X_younger_sibs[,i] + Fprojstar %*% X_parents[,i]
+ X_younger_niece_nephew[,i+1] <- Uproj %*% X_younger_niece_nephew[,i] + Fproj %*% X_younger_sibs[,i]
+ X_children[,i+1] <- Uproj %*% X_children[,i] + Fproj %*% X_Focal[,i]
+ X_grand_children[,i+1] <- Uproj %*% X_grand_children[,i] + Fproj %*% X_children[,i]
+ X_great_grand_children[,i+1] <- Uproj %*% X_great_grand_children[,i] + Fproj %*% X_grand_children[,i]
+ }
+
+ ### IC for kin which are derived from above kin (Focal, parents, children, grand+great children, younger siblings, and younger nieces/nehpews):
+ # grand parents, older sibs, younger aunts/uncles, older nieces/nephews
+ IC_f_grand_pars <- mothers_age_dist
+ IC_m_grand_pars <- fathers_age_dist
+ IC_f_great_grand_pars <- mothers_age_dist
+ IC_m_great_grand_pars <- fathers_age_dist
+ IC_older_sibs_f <- mothers_age_dist
+ IC_younger_aunts_uncles_f <- mothers_age_dist
+ IC_younger_aunts_uncles_m <- fathers_age_dist
+ IC_older_niece_nephew_f <- mothers_age_dist
+ for(ic in 1 : (na)){
+ X_grand_parents[, 1] <- X_grand_parents[, 1] + (IC_f_grand_pars[ic] + IC_m_grand_pars[ic])*X_parents[,ic] ## IC the sum of parents of Focal's parents,
+ X_great_grand_parents[, 1] <- X_great_grand_parents[, 1] + (IC_f_great_grand_pars[ic] + IC_m_great_grand_pars[ic])*X_grand_parents[,ic]
+ X_older_sibs[,1] <- X_older_sibs[,1] + IC_older_sibs_f[ic]*X_children[,ic]
+ X_older_niece_nephew[,1] <- X_older_niece_nephew[,1] + IC_older_niece_nephew_f[ic]*X_grand_children[,ic]
+ X_younger_aunts_uncles[,1] <- X_younger_aunts_uncles[,1] + (IC_younger_aunts_uncles_f[ic] + IC_younger_aunts_uncles_m[ic])*X_younger_sibs[,ic]
+ }
+
+ ### Projections of grand parenst, older sibs, younger aunts/uncles, older nieces/nephews
+ for(i in 1: (na-1)){
+ X_grand_parents[, i+1] <- Uproj %*% X_grand_parents[, i]
+ X_great_grand_parents[, i+1] <- Uproj %*% X_great_grand_parents[, i]
+ X_older_sibs[,i+1] <- Uproj %*% X_older_sibs[,i]
+ X_older_niece_nephew[,i+1] <- Uproj %*% X_older_niece_nephew[,i] + Fproj %*% X_older_sibs[,i]
+ X_younger_aunts_uncles[,i+1] <- Uproj %*% X_younger_aunts_uncles[,i] + Fprojstar %*% X_grand_parents[,i]
+ }
+
+ ### IC for kin which are derived from above kin (older sibs, younger aunts/uncles, older nieces/nephews):
+ ## older unts/uncles, older cousins, younger cousins
+ IC_older_aunt_uncle_f <- mothers_age_dist
+ IC_older_aunt_uncle_m <- fathers_age_dist
+ IC_older_cousins_f <- mothers_age_dist
+ IC_older_cousins_m <- fathers_age_dist
+ IC_younger_cousins_f <- mothers_age_dist
+ IC_younger_cousins_m <- fathers_age_dist
+ for(ic in 1 : (na-1)){
+ X_older_aunt_uncle[,1] <- X_older_aunt_uncle[,1] + (IC_older_aunt_uncle_f[ic] + IC_older_aunt_uncle_m[ic])*X_older_sibs[,ic]
+ X_older_cousins[,1] <- X_older_cousins[,1] + (IC_older_cousins_f[ic] + IC_older_cousins_m[ic])*X_older_niece_nephew[,ic]
+ X_younger_cousins[,1] <- X_younger_cousins[,1] + (IC_younger_cousins_f[ic] + IC_younger_cousins_m[ic])*X_younger_niece_nephew[,ic]
+ }
+
+ ## Projections of older unts/uncles, older cousins, younger cousins
+ for(i in 1: (na-1)){
+ X_older_aunt_uncle[,i+1] <- Uproj %*% X_older_aunt_uncle[,i]
+ X_older_cousins[,i+1] <- Uproj %*% X_older_cousins[,i] + Fproj %*% X_older_aunt_uncle[,i]
+ X_younger_cousins[,i+1] <- Uproj %*% X_younger_cousins[,i] + Fproj %*% X_younger_aunts_uncles[,i]
+ }
+
+ #### OUTPUT of all kin
+ return(list("Focal" = X_Focal,
+ "d" = X_children,
+ "gd" = X_grand_children,
+ "ggd" = X_great_grand_children,
+ "m" = X_parents,
+ "gm" = X_grand_parents,
+ "ggm" = X_great_grand_parents,
+ "os" = X_older_sibs,
+ "ys" = X_younger_sibs,
+ "nos" = X_older_niece_nephew,
+ "nys" = X_younger_niece_nephew,
+ "oa" = X_older_aunt_uncle,
+ "ya" = X_younger_aunts_uncles,
+ "coa" = X_older_cousins,
+ "cya" = X_younger_cousins,
+ "ps" = population_age_stage_structure
+ ))
+}
+
+
+#' Title time-variant two-sex multi-state kin projections
+#'
+#' @param Uf matrix (block structured). transfers female individuals across stages and advances their age (conditional on survial)
+#' @param Um matrix (block structured). transfers male individuals across stages and advances their age (conditional on survial)
+#' @param Ff matrix (block structured). accounts for female reproduction, and assigns newborns into given age*stage
+#' @param Fm matrix (block structured). accounts for male reproduction; assigns newborns into age-class, and stage
+#' @param alpha scalar. birth ratio (male:female)
+#' @param na scalar. number of ages.
+#' @param ns scalar. number of stages.
+#' @param Parity logical. If true then we omit mothers of parity 0, and re-scale the mother's age*stage of parenting
+#' @param sex_Focal logical. Female or Male
+#' @param Initial_stage_Focal numeric. Any natural number {1,2,3,4,...}
+#' @param previous_kin_Focal matrix. last years kinship output.
+#' @param prev_kin_children matrix. last years kinship output.
+#' @param prev_kin_grandchildren matrix. last years kinship output.
+#' @param prev_kin_greatgrandchildren matrix. last years kinship output.
+#' @param prev_kin_parents matrix. last years kinship output.
+#' @param prev_kin_grand_parents matrix. last years kinship output.
+#' @param prev_kin_older_sibs matrix. last years kinship output.
+#' @param prev_kin_younger_sibs matrix. last years kinship output.
+#' @param prev_kin_older_niece_nephew matrix. last years kinship output.
+#' @param prev_kin_younger_niece_nephew matrix. last years kinship output.
+#' @param prev_kin_older_aunts_uncles matrix. last years kinship output.
+#' @param prev_kin_younger_aunts_uncles matrix. last years kinship output.
+#' @param prev_kin_older_cousins matrix. last years kinship output.
+#' @param prev_kin_younger_cousins matrix. last years kinship output.
+#' @param previous_population_age_stage_structure vector. The transient "population structure" (age*stage distributed)
+#'
+#' @return a list of matrices. Each list entry represents a particular kin. Each kin is chacacterised by a matrix of dimension:
+#' nrow = 2* na * ns (2-sex age-stage structured) and ncol = na (Focal's age)
+#' yielding the age*stage distribution of kin for each age of Focal
+#'
+all_kin_dy_TV <- function(Uf,
+ Um,
+ Ff,
+ Fm,
+ alpha, ## alpha = sex ratio male:female (i.e., 1 - birth_female)
+ na, ## number of ages
+ ns, ## number of stages
+ Parity,
+ sex_Focal,
+ Initial_stage_Focal,
+ previous_kin_Focal,
+ prev_kin_children,
+ prev_kin_grandchildren,
+ prev_kin_greatgrandchildren,
+ prev_kin_parents,
+ prev_kin_grand_parents,
+ prev_kin_great_grand_parents,
+ prev_kin_older_sibs,
+ prev_kin_younger_sibs,
+ prev_kin_older_niece_nephew,
+ prev_kin_younger_niece_nephew,
+ prev_kin_older_aunts_uncles,
+ prev_kin_younger_aunts_uncles,
+ prev_kin_older_cousins,
+ prev_kin_younger_cousins,
+ previous_population_age_stage_structure){
+
+ n <- nrow(Uf)
+ Uproj <- Matrix::Matrix(block_diag_function(list(Uf, Um)), sparse = TRUE)
+ Fproj <- Matrix::Matrix(nrow = (2*n), ncol = (2*n), data = 0, sparse = TRUE)
+ Fproj[1:n, 1:n] <- (1-alpha)*Ff
+ Fproj[(n+1):(2*n), 1:n] <- alpha*Ff
+ Fproj[1:n, (n+1):(2*n)] <- (1-alpha)*Fm
+ Fproj[(n+1):(2*n), (n+1):(2*n)] <- alpha*Fm
+ Fprojstar <- Matrix::Matrix(nrow = (2*n), ncol = (2*n), data = 0, sparse = TRUE) ## Block structured F_tilde
+ Fprojstar[1:n, 1:n] <- (1-alpha)*Ff
+ Fprojstar[(n+1):(2*n), 1:n] <- alpha*Ff
+
+ population_age_stage_structure <- previous_population_age_stage_structure
+ population_age_stage_structure <- population_age_stage_structure/sum(population_age_stage_structure)
+ population_age_stage_structure_next <- (Uproj + Fprojstar)%*%population_age_stage_structure
+
+ ### Stable distribution of mothers needs adjusting if we work with parity
+ if(Parity){
+ Initial_stage_Focal <- 1
+
+ population_age_stage_of_parenting <- pi_mix_TV_parity(Ff, Fm, alpha, na, ns, population_age_stage_structure)
+
+ parents_joint_age_stage <- population_age_stage_of_parenting[[1]]
+
+ mothers_age_stage <- population_age_stage_of_parenting[[2]]
+ fathers_age_stage <- population_age_stage_of_parenting[[3]]
+
+ mothers_age_dist <- population_age_stage_of_parenting[[4]]
+ fathers_age_dist <- population_age_stage_of_parenting[[5]]
+
+ }
+ else{
+
+ population_age_stage_of_parenting <- pi_mix_TV(Ff, Fm, alpha, na, ns, population_age_stage_structure)
+
+ parents_joint_age_stage <- population_age_stage_of_parenting[[1]]
+
+ mothers_age_stage <- population_age_stage_of_parenting[[2]]
+ fathers_age_stage <- population_age_stage_of_parenting[[3]]
+
+ mothers_age_dist <- population_age_stage_of_parenting[[4]]
+ fathers_age_dist <- population_age_stage_of_parenting[[5]]
+
+ }
+
+ ### Focal requires its own dynamic: G_tilde constructed below tracks Focal's age*stage advancement over the time-scale
+ f_t <- get_G(Uf, na, ns) ## get_G function in "Functions_required.R"
+ m_t <- get_G(Um, na, ns)
+ G_tilde <- block_diag_function(list(f_t,m_t))
+ X_Focal <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ IC_Focal <- rep(0, 2*n)
+ if(sex_Focal == "Female"){
+ entry <- 1 + (Initial_stage_Focal-1)*na
+ IC_Focal[entry] <- 1}
+ else{
+ entry <- n + 1 + (Initial_stage_Focal-1)*na
+ IC_Focal[entry] <- 1
+ }
+
+ ### empty kin matrices for all of Focal's kin
+ X_children <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_grand_children <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_great_grand_children <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_parents <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_grand_parents <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_great_grand_parents <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_older_sibs <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_younger_sibs <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_older_niece_nephew <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_younger_niece_nephew <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_older_aunt_uncle <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_younger_aunts_uncles <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_older_cousins <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+ X_younger_cousins <- Matrix::Matrix(nrow = (2*n), ncol = na, data = 0, sparse = TRUE)
+
+ ### Initial distributions for kin with non-zero deterministic initial conditions:
+ ## Focal, parents, children, grand+great children, younger siblings, and younger nieces/nehpews
+ X_Focal[,1] <- IC_Focal
+ X_parents[, 1] <- parents_joint_age_stage
+ ### projection all above kin with deterministic initial conditions
+ for(i in 1 : (na-1)){
+ X_Focal[,i+1] <- G_tilde %*% previous_kin_Focal[,i]
+ X_parents[, i+1] <- Uproj %*% prev_kin_parents[, i]
+ X_younger_sibs[,i+1] <- Uproj %*% prev_kin_younger_sibs[,i] + Fprojstar %*% prev_kin_parents[,i]
+ X_younger_niece_nephew[,i+1] <- Uproj %*% prev_kin_younger_niece_nephew[,i] + Fproj %*% prev_kin_younger_sibs[,i]
+ X_children[,i+1] <- Uproj %*% prev_kin_children[,i] + Fproj %*% previous_kin_Focal[,i]
+ X_grand_children[,i+1] <- Uproj %*% prev_kin_grandchildren[,i] + Fproj %*% prev_kin_children[,i]
+ X_great_grand_children[,i+1] <- Uproj %*% prev_kin_greatgrandchildren[,i] + Fproj %*% prev_kin_grandchildren[,i]
+ }
+
+ ### IC for kin which are derived from above kin (Focal, parents, children, grand+great children, younger siblings, and younger nieces/nehpews):
+ # grand parents, older sibs, younger aunts/uncles, older nieces/nephews
+ IC_f_grand_pars <- mothers_age_dist
+ IC_m_grand_pars <- fathers_age_dist
+ IC_f_great_grand_pars <- mothers_age_dist
+ IC_m_great_grand_pars <- fathers_age_dist
+ IC_younger_aunts_uncles_f <- mothers_age_dist
+ IC_younger_aunts_uncles_m <- fathers_age_dist
+ IC_older_sibs_f <- mothers_age_dist
+ IC_older_niece_nephew_f <- mothers_age_dist
+ for(ic in 1 : (na)){
+ X_grand_parents[, 1] <- X_grand_parents[, 1] + (IC_f_grand_pars[ic] + IC_m_grand_pars[ic])*prev_kin_parents[,ic] ## IC the sum of parents of Focal's parents,
+ X_great_grand_parents[, 1] <- X_great_grand_parents[, 1] + (IC_f_great_grand_pars[ic] + IC_m_great_grand_pars[ic])*prev_kin_grand_parents[,ic]
+ X_older_sibs[,1] <- X_older_sibs[,1] + IC_older_sibs_f[ic]*prev_kin_children[,ic]
+ X_older_niece_nephew[,1] <- X_older_niece_nephew[,1] + IC_older_niece_nephew_f[ic]*prev_kin_grandchildren[,ic]
+ X_younger_aunts_uncles[,1] <- X_younger_aunts_uncles[,1] + (IC_younger_aunts_uncles_f[ic] + IC_younger_aunts_uncles_m[ic])*prev_kin_younger_sibs[,ic]
+ }
+
+ ### Projections of older sibs, younger aunts/uncles, older nieces/nephews
+ for(i in 1: (na-1)){
+ X_grand_parents[, i+1] <- Uproj %*% prev_kin_grand_parents[, i]
+ X_great_grand_parents[, i+1] <- Uproj %*% prev_kin_great_grand_parents[, i]
+ X_older_sibs[,i+1] <- Uproj %*% prev_kin_older_sibs[,i]
+ X_older_niece_nephew[,i+1] <- Uproj %*% prev_kin_older_niece_nephew[,i] + Fproj %*% prev_kin_older_sibs[,i]
+ X_younger_aunts_uncles[,i+1] <- Uproj %*% prev_kin_younger_aunts_uncles[,i] + Fprojstar %*% prev_kin_grand_parents[,i]
+ }
+
+ ### IC for kin which are derived from above kin (older sibs, younger aunts/uncles, older nieces/nephews):
+ ## older unts/uncles, older cousins, younger cousins
+ IC_older_aunt_uncle_f <- mothers_age_dist
+ IC_older_aunt_uncle_m <- fathers_age_dist
+ IC_older_cousins_f <- mothers_age_dist
+ IC_older_cousins_m <- fathers_age_dist
+ IC_younger_cousins_f <- mothers_age_dist
+ IC_younger_cousins_m <- fathers_age_dist
+ for(ic in 1 : (na-1)){
+ X_older_aunt_uncle[,1] <- X_older_aunt_uncle[,1] + (IC_older_aunt_uncle_f[ic] + IC_older_aunt_uncle_m[ic])*prev_kin_older_sibs[,ic]
+ X_older_cousins[,1] <- X_older_cousins[,1] + (IC_older_cousins_f[ic] + IC_older_cousins_m[ic])*prev_kin_older_niece_nephew[,ic]
+ X_younger_cousins[,1] <- X_younger_cousins[,1] + (IC_younger_cousins_f[ic] + IC_younger_cousins_m[ic])*prev_kin_younger_niece_nephew[,ic]
+ }
+
+ ## Projections of older unts/uncles, older cousins, younger cousins
+ for(i in 1: (na-1)){
+ X_older_aunt_uncle[,i+1] <- Uproj %*% prev_kin_older_aunts_uncles[,i]
+ X_older_cousins[,i+1] <- Uproj %*% prev_kin_older_cousins[,i] + Fproj %*% prev_kin_older_aunts_uncles[,i]
+ X_younger_cousins[,i+1] <- Uproj %*% prev_kin_younger_cousins[,i] + Fproj %*% prev_kin_younger_aunts_uncles[,i]
+ }
+
+ return(list("Focal" = X_Focal,
+ "d" = X_children,
+ "gd" = X_grand_children,
+ "ggd" = X_great_grand_children,
+ "m" = X_parents,
+ "gm" = X_grand_parents,
+ "ggm" = X_great_grand_parents,
+ "os" = X_older_sibs,
+ "ys" = X_younger_sibs,
+ "nos" = X_older_niece_nephew,
+ "nys" = X_younger_niece_nephew,
+ "oa" = X_older_aunt_uncle,
+ "ya" = X_younger_aunts_uncles,
+ "coa" = X_older_cousins,
+ "cya" = X_younger_cousins,
+ "ps" = population_age_stage_structure_next))
+}
+
+################## Create data frame output
+
+## Use of "pipe" (don't understand the name, but hey)
+`%>%` <- magrittr::`%>%`
+
+#' Title Accumulated kin by each age of Focal, for each time period, and cohort of birth
+#'
+#' @param kin_matrix_lists list of lists of kin matrices: list( list(X_focal), list(X_parents), ... ). Outer list is length 14 = number of kin. Inner lists have lenght = timescale
+#' so list(X_focal) = list(X_focal[year1],X_focal[year2],...,X_focal[yearlast])
+#' @param kin_names list of characters. Corresponding to above lists: list("F","m",....)
+#' @param years vector. The timescale on which we implement the kinship model.
+#' @param start_year . First year of varying vital rates (e.g., if years = 1990:2000 then start_year = 1990)
+#' @param na numeric. Number of ages.
+#' @param ns numeric. Number of stages.
+#' @param specific_kin character. names of kin we wish to analyse, e.g., list("os","ys"). If null returns all 14.
+#'
+#' @return A data frame which gives for each age of Focal at each year in the timescale, Focal's experienced number kin demarcated by stages (summed over all ages)
+#'
+create_cumsum_df <- function(kin_matrix_lists,
+ kin_names,
+ years,
+ start_year,
+ na,
+ ns,
+ specific_kin = NULL){
+ df_year_list <- list()
+ for(j in years){
+ ii <- as.numeric(j) - start_year + 1
+ df_list <- list()
+ for(i in 1 : length(kin_names)){
+ kin_member <- kin_names[[i]]
+ kin_data <- kin_matrix_lists[[i]]
+ kin_data <- kin_data[[ii]]
+ df <- as.data.frame(as.matrix(kin_data))
+ dims <- dim( kin_data)
+ nr <- dims[1]
+ nc <- dims[2]
+ female_kin <- df[1:(nr/2), 1:nc]
+ male_kin <- df[ (1+nr/2) : nr, 1:nc]
+ female_kin$stage <- rep(seq(1, ns), na)
+ male_kin$stage <- rep(seq(1, ns), na)
+ female_kin$age <- rep(seq(0, (na-1)), each = ns)
+ male_kin$age <- rep(seq(0, (na-1)), each = ns)
+ female_kin$Sex <- "Female"
+ male_kin$Sex <- "Male"
+ both_kin <- rbind(female_kin, male_kin)
+ both_kin <- both_kin %>% reshape2::melt(id = c("age","stage","Sex")) %>%
+ dplyr::group_by(variable, stage, Sex) %>%
+ dplyr::summarise(num = sum(value)) %>%
+ dplyr::ungroup()
+ both_kin <- both_kin %>% dplyr::transmute(age_focal = variable,
+ stage_kin = as.factor(stage),
+ count = num,
+ sex_kin = Sex)
+ both_kin$age_focal <- as.numeric(gsub("[^0-9.-]", "", both_kin$age_focal)) - 1
+ df <- both_kin
+ df$year <- j
+ df$group <- kin_member
+ df_list[[length(df_list)+1]] <- df
+ }
+ df_list <- do.call("rbind", df_list)
+ df_year_list[[(1+length(df_year_list))]] <- df_list
+ }
+ df_year_list <- do.call("rbind", df_year_list)
+ df_year_list <- df_year_list %>% dplyr::mutate(cohort = as.numeric(year) - as.numeric(age_focal),
+ cohort_factor = as.factor(cohort))
+ if(!is.null(specific_kin)){
+ df_year_list <- df_year_list %>% dplyr::filter(group %in% specific_kin)
+ }
+ return(df_year_list)
+}
+
+#' Title joint age*stage distributions of kin by each age of Focal, for each time period, and cohort of birth
+#'
+#' @param kin_matrix_lists list of lists of kin matrices: list( list(X_focal), list(X_parents), ... ). Outer list is length 14 = number of kin. Inner lists have lenght = timescale
+#' so list(X_focal) = list(X_focal[year1],X_focal[year2],...,X_focal[yearlast])
+#' @param kin_names list of characters. Corresponding to above lists: list("F","m",....)
+#' @param years vector. The timescale on which we implement the kinship model.
+#' @param start_year . First year of varying vital rates (e.g., if years = 1990:2000 then start_year = 1990)
+#' @param na numeric. Number of ages.
+#' @param ns numeric. Number of stages.
+#' @param specific_kin character. names of kin we wish to analyse, e.g., list("os","ys"). If null returns all 14.
+#'
+#' @return A data frame which gives for each age of Focal at each year in the timescale, the full age*stage dist of kin
+#'
+create_full_dists_df <- function(kin_matrix_lists,
+ kin_names,
+ years,
+ start_year,
+ na,
+ ns,
+ specific_kin = NULL){
+ df_year_list <- list()
+ for(j in years){
+ ii <- as.numeric(j) - start_year + 1
+ df_list <- list()
+ for(i in 1 : length(kin_names)){
+ kin_member <- kin_names[[i]]
+ kin_data <- kin_matrix_lists[[i]]
+ kin_data <- kin_data[[ii]]
+ df <- as.data.frame(as.matrix(kin_data))
+ dims <- dim( kin_data)
+ nr <- dims[1]
+ nc <- dims[2]
+ female_kin <- df[1:(nr/2), 1:nc]
+ male_kin <- df[ (1+nr/2) : nr, 1:nc]
+ female_kin$stage <- rep(seq(1, ns), na)
+ male_kin$stage <- rep(seq(1, ns), na)
+ female_kin$age <- rep(seq(0, (na-1)), each = ns)
+ male_kin$age <- rep(seq(0, (na-1)), each = ns)
+ female_kin$Sex <- "Female"
+ male_kin$Sex <- "Male"
+ both_kin <- rbind(female_kin, male_kin)
+ both_kin <- both_kin %>% reshape2::melt(id = c("age","stage","Sex")) %>%
+ dplyr::transmute(age_focal = variable,
+ age_kin = age,
+ stage_kin = as.factor(stage),
+ count = value,
+ sex_kin = Sex)
+ both_kin$age_focal <- as.numeric(gsub("[^0-9.-]", "", both_kin$age_focal))-1
+ df <- both_kin
+ df$year <- j
+ df$group <- kin_member
+ df_list[[length(df_list)+1]] <- df
+ }
+ df_list <- do.call("rbind", df_list)
+ df_year_list[[(1+length(df_year_list))]] <- df_list
+ }
+ df_year_list <- do.call("rbind", df_year_list)
+ df_year_list <- df_year_list %>% dplyr::mutate(cohort = as.numeric(year) - as.numeric(age_focal),
+ cohort_factor = as.factor(cohort))
+ if(!is.null(specific_kin)){
+ df_year_list <- df_year_list %>% dplyr::filter(group %in% specific_kin)
+ }
+ return(df_year_list)
+}
+
+
+
+## Construct a matrix composed as a direct sum of a list of matrices
+block_diag_function <- function(mat_list){
+ s = length(mat_list)
+ u1 = mat_list[[1]]
+ dims <- dim(u1)
+ r = dims[1]
+ diagmat <- Matrix::Matrix(nrow = (r*s), ncol = (r*s), data = 0, sparse = TRUE)
+ for(i in 1:s){
+ diagmat = diagmat + kronecker(E_matrix(i,i,s,s), mat_list[[i]])
+ }
+ return(diagmat)
+}
+
+## Construct a matrix which transfers Focal across stages, while ensuring Focal survives with probability 1
+get_G <- function(U, na, ns){
+ sig <- Matrix::t(rep(1,na*ns)) %*% U
+ diag <- Matrix::diag(sig[1,])
+ G <- U %*% MASS::ginv(diag)
+ return(G)
+}
+
+#' Mixing distributions for the time-invariant multi-state 2-sex model: Non-parity case
+#'
+#' @param Uf matrix. Block-structured matrix which transfers females over stage and advances their age
+#' @param Um matrix. Block-structured matrix which transfers males over stage and advances their age
+#' @param Ff matrix. Block-structured matrix which counts reproduction by females and assigns newborns an age and stage
+#' @param Fm matrix. Block-structured matrix which counts reproduction by males and assigns newborns an age and stage
+#' @param alpha scalar. Birth ratio male:female
+#' @param na scalar. Number of age-classes
+#' @param ns scalar. Number of stages
+#'
+#' @return list (of vectors). list[[1]] = full age*stage*sex distribution
+#' list[[2]] = female age*stage distribution normalised
+#' list[[3]] = male age*stage distribution normalised
+#' list[[4]] = female marginal age distribution normalised
+#' list[[5]] = male marginal age distribution normalised
+#'
+pi_mix <- function(Uf, Um, Ff, Fm, alpha, na, ns){
+ n <- length(Uf[1,])
+ F_block <- Matrix::Matrix(nrow = (2*n), ncol = (2*n), data = 0, sparse = TRUE)
+ F_block[1:n, 1:n] <- (1-alpha)*Ff
+ F_block[ (1+n):(2*n), 1:n] <- alpha*Ff
+ A <- block_diag_function(list(Uf,Um)) + F_block
+ stable_dist_vec <- SD(A)
+ ### Joint distributions
+ pi_f <- Matrix::t( rep(1, na*ns) %*% Ff )*stable_dist_vec[1:n]
+ pi_f <- pi_f / abs(sum(pi_f))
+ pi_m <- Matrix::t( rep(1, na*ns) %*% Fm )*stable_dist_vec[(1+n):(2*n)]
+ pi_m <- pi_m / abs(sum(pi_m))
+ ### Age distributions
+ pi_F <- kronecker( diag(na), Matrix::t(rep(1, ns)) ) %*% (pi_f)
+ pi_M <- kronecker( diag(na), Matrix::t(rep(1, ns)) ) %*% (pi_m)
+ return(list(rbind(pi_f,pi_m),pi_f,pi_m,pi_F,pi_M))
+}
+
+#' Mixing distributions for the time-variant multi-state 2-sex model: Non-parity case
+#'
+#' @param Ff matrix. Block-structured matrix which counts reproduction by females and assigns newborns an age and stage
+#' @param Fm matrix. Block-structured matrix which counts reproduction by males and assigns newborns an age and stage
+#' @param alpha scalar. Birth ratio male:female
+#' @param na scalar. Number of age-classes
+#' @param ns scalar. Number of stages
+#' @param previous_age_stage_dist vector. Last years population structure (age*stage*sex full distribution)
+#'
+#' @return list (of vectors). list[[1]] = full age*stage*sex distribution
+#' list[[2]] = female age*stage distribution normalised
+#' list[[3]] = male age*stage distribution normalised
+#' list[[4]] = female marginal age distribution normalised
+#' list[[5]] = male marginal age distribution normalised
+#'
+pi_mix_TV <- function(Ff, Fm, alpha, na, ns, previous_age_stage_dist){
+ n <- length(Ff[1,])
+ ### Joint distributions
+ pi_f <- Matrix::t( rep(1,na*ns) %*% Ff )*previous_age_stage_dist[1:n]
+ pi_f <- pi_f / abs(sum(pi_f))
+ pi_m <- Matrix::t( rep(1,na*ns) %*% Fm )*previous_age_stage_dist[(1+n):(2*n)]
+ pi_m <- pi_m / abs(sum(pi_m))
+ ### Age distributions
+ pi_F <- kronecker( diag(na), Matrix::t(rep(1, ns)) ) %*% (pi_f)
+ pi_M <- kronecker( diag(na), Matrix::t(rep(1, ns)) ) %*% (pi_m)
+ return(list(rbind(pi_f,pi_m),pi_f,pi_m,pi_F,pi_M))
+}
+
+#' Mixing distributions for the time-invariant multi-state 2-sex model: Parity-specific case
+#'
+#' @param Uf matrix. Block-structured matrix which transfers females over stage and advances their age
+#' @param Um matrix. Block-structured matrix which transfers males over stage and advances their age
+#' @param Ff matrix. Block-structured matrix which counts reproduction by females and assigns newborns an age and stage
+#' @param Fm matrix. Block-structured matrix which counts reproduction by males and assigns newborns an age and stage
+#' @param alpha scalar. Birth ratio male:female
+#' @param na scalar. Number of age-classes
+#' @param ns scalar. Number of stages
+#'
+#' @return list (of vectors). list[[1]] = full age*stage*sex distribution
+#' list[[2]] = female age*stage distribution normalised
+#' list[[3]] = male age*stage distribution normalised
+#' list[[4]] = female marginal age distribution normalised
+#' list[[5]] = male marginal age distribution normalised
+#'
+pi_mix_parity <- function(Uf, Um, Ff, Fm, alpha, na, ns){
+ n <- length(Uf[1,])
+ F_block <- Matrix::Matrix(nrow = (2*n), ncol = (2*n), data = 0, sparse = TRUE)
+ F_block[1:n, 1:n] <- (1-alpha)*Ff
+ F_block[ (1+n):(2*n), 1:n] <- alpha*Ff
+ A <- block_diag_function(list(Uf,Um)) + F_block
+ stable_dist_vec <- SD(A)
+ pi_f <- Matrix::t( rep(1, na*ns) %*% Ff )*stable_dist_vec[1:n]
+ pi_f <- pi_f / abs(sum(pi_f))
+ pi_m <- Matrix::t( rep(1, na*ns) %*% Fm )*stable_dist_vec[(1+n):(2*n)]
+ pi_m <- pi_m / abs(sum(pi_m))
+ m_mat <- pi_f %*% Matrix::t(rep(1,na))
+ d_mat <- pi_m %*% Matrix::t(rep(1,na))
+ pi_F <- kronecker( diag(1, na), Matrix::t(rep(1,ns)) ) %*% pi_f
+ pi_M <- kronecker( diag(1, na), Matrix::t(rep(1,ns)) ) %*% pi_m
+ for(i in 1:na){
+ m_mat[,i] <- kronecker( E_matrix(i,i,na,na) , Matrix::diag( c(0, rep(1, ns-1)) ) ) %*% m_mat[,i]
+ d_mat[,i] <- kronecker( E_matrix(i,i,na,na) , Matrix::diag( c(0, rep(1, ns-1)) ) ) %*% d_mat[,i]
+ }
+ out_mum <- m_mat %*% MASS::ginv(Matrix::diag(Matrix::colSums(m_mat)))
+ out_dad <- d_mat %*% MASS::ginv(Matrix::diag(Matrix::colSums(d_mat)))
+ ### Joint distributions
+ pi_f <- out_mum %*% pi_F
+ pi_m <- out_dad %*% pi_M
+ return(list(rbind(pi_f,pi_m), pi_f, pi_m, pi_F, pi_M))
+}
+
+#' Mixing distributions for the time-variant multi-state 2-sex model: Parity-specific case
+#'
+#' @param Uf matrix. Block-structured matrix which transfers females over stage and advances their age
+#' @param Um matrix. Block-structured matrix which transfers males over stage and advances their age
+#' @param Ff matrix. Block-structured matrix which counts reproduction by females and assigns newborns an age and stage
+#' @param Fm matrix. Block-structured matrix which counts reproduction by males and assigns newborns an age and stage
+#' @param alpha scalar. Birth ratio male:female
+#' @param na scalar. Number of age-classes
+#' @param ns scalar. Number of stages
+#' @param previous_age_stage_dist vector. Last years population structure (age*stage*sex full distribution)
+#'
+#' @return list (of vectors). list[[1]] = full age*stage*sex distribution
+#' list[[2]] = female age*stage distribution normalised
+#' list[[3]] = male age*stage distribution normalised
+#' list[[4]] = female marginal age distribution normalised
+#' list[[5]] = male marginal age distribution normalised
+#'
+pi_mix_TV_parity <- function(Ff, Fm, alpha, na, ns, previous_age_stage_dist){
+ n <- length(Ff[1,])
+ pi_f <- Matrix::t( rep(1,na*ns) %*% Ff )*previous_age_stage_dist[1:n]
+ pi_f <- pi_f / abs(sum(pi_f))
+ pi_m <- Matrix::t( rep(1,na*ns) %*% Fm )*previous_age_stage_dist[(1+n):(2*n)]
+ pi_m <- pi_m / abs(sum(pi_m))
+ m_mat <- pi_f %*% Matrix::t(rep(1,na))
+ d_mat <- pi_m %*% Matrix::t(rep(1,na))
+ pi_F <- kronecker( Matrix::diag(1, na), Matrix::t(rep(1,ns)) ) %*% pi_f
+ pi_M <- kronecker( Matrix::diag(1, na), Matrix::t(rep(1,ns)) ) %*% pi_m
+ for(i in 1:na){
+ m_mat[,i] <- kronecker( E_matrix(i,i,na,na) , Matrix::diag( c(0, rep(1, ns-1)) ) ) %*% m_mat[,i]
+ d_mat[,i] <- kronecker( E_matrix(i,i,na,na) , Matrix::diag( c(0, rep(1, ns-1)) ) ) %*% d_mat[,i]
+ }
+ out_mum <- m_mat %*% MASS::ginv(Matrix::diag(Matrix::colSums(m_mat)))
+ out_dad <- d_mat %*% MASS::ginv(Matrix::diag(Matrix::colSums(d_mat)))
+ ### Joint distributions
+ pi_f <- out_mum %*% pi_F
+ pi_m <- out_dad %*% pi_M
+ return(list(rbind(pi_f,pi_m),pi_f,pi_m,pi_F,pi_M))
+}
+
+
+######################################################### Some useful utility functions required
+
+
+###################################################### Eigen-decomposition of a matrix
+
+# Calculate the spectral radius of a matrix (growth rate in Demographics)
+lambda <- function(PM) {
+ lead_eig <- (abs(eigen(PM, only.values = TRUE)$values))
+ lead_eig <- lead_eig[which.max(lead_eig)]
+ return(lead_eig)
+}
+# Find the column-eigenvector corresponding to the spectral radius (Stable population structure in Demographics)
+SD <- function(PM) {
+ spectral_stuff <- eigen(PM)
+ spectral_stuff <- Re(spectral_stuff$vectors[, which.max(abs(spectral_stuff$values))])
+ # normalise...
+ vec_lambda <- spectral_stuff/sum(spectral_stuff)
+ return(vec_lambda)
+}
+# Find the row-eigenvector corresponding to the spectral radius (Stable reproductive values in Demographics)
+RD <- function(PM) {
+ spectral_stuff <- eigen(t(PM))
+ spectral_stuff <- Re(spectral_stuff$vectors[, which.max(abs(spectral_stuff$values))])
+ # normalise...
+ vec_lambda <- spectral_stuff/sum(spectral_stuff)
+ return(vec_lambda)
+}
+
+###################################################### Useful matrix operations
+
+## Constructing a unit vector with a 1 in the ith position
+e_vector <- function(i, n){
+ e <- rep(0, n)
+ e[i] <- 1
+ return(e)
+}
+## Creating a matrix of zeros with a 1 in the i,j-th entry
+E_matrix <- function(i,j,n,m){
+ E <- Matrix::Matrix(nrow = (n), ncol = (m), data = 0, sparse = TRUE)
+ E[i,j] <- 1
+ return(E)
+
+}
+## Creating the Vec-commutation matrix
+K_perm_mat <- function(n,m){
+ perm <- Matrix::Matrix(nrow = (n*m), ncol = (n*m), data = 0, sparse = TRUE)
+ for(i in 1:n){
+ for(j in 1:m){
+ perm = perm + kronecker( E_matrix(i,j,n,m) , Matrix::t(E_matrix(i,j,n,m)) )
+ }
+ }
+ return(perm)
+}
+
+
+
+
+
+
+
+
diff --git a/R/kin_time_invariant.R b/R/kin_time_invariant.R
index d843c4e..06058b6 100644
--- a/R/kin_time_invariant.R
+++ b/R/kin_time_invariant.R
@@ -1,37 +1,40 @@
-#' Estimate kin counts in a time invariant framework
+#' Estimate kin counts in a time invariant framework for one-sex model (matrilineal/patrilineal)
-#' @description Implementation of Goodman-Keyfitz-Pullum equations adapted by Caswell (2019).
+#' @description Mtrix implementation of Goodman-Keyfitz-Pullum equations adapted by Caswell (2019).
-#' @param U numeric. A vector of survival probabilities with same length as ages.
+#' @param p numeric. A vector of survival probabilities with same length as ages.
#' @param f numeric. A vector of age-specific fertility rates with same length as ages.
#' @param birth_female numeric. Female portion at birth.
#' @param pi numeric. For using some specific non-stable age distribution of childbearing (same length as ages). Default `NULL`.
-#' @param output_kin character. kin to return. For example "m" for mother, "d" for daughter. See the `vignette` for all kin types.
+#' @param output_kin character. kin to return. For example "m" for mother, "d" for daughter. See `vignette` for all kin types.
#' @param list_output logical. Results as a list with `output_kin` elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default `FALSE`
#'
#' @return A data frame with focal´s age, related ages and type of kin
#' (for example `d` is daughter, `oa` is older aunts, etc.), alive and death. If `list_output = TRUE` then this is a list.
#' @export
-kin_time_invariant <- function(U = NULL, f = NULL,
+kin_time_invariant <- function(p = NULL, f = NULL,
birth_female = 1/2.04,
pi = NULL,
output_kin = NULL,
list_output = FALSE){
+ # global vars
+ .<-alive<-age_kin<-alive<-age_focal<-count<-NULL
+
# make matrix transition from vectors
- age = 0:(length(U)-1)
+ age = 0:(length(p)-1)
ages = length(age)
- Ut = Mt = zeros = Dcum = matrix(0, nrow=ages, ncol=ages)
- Ut[row(Ut)-1 == col(Ut)] <- U[-ages]
- Ut[ages, ages] = U[ages]
- diag(Mt) = 1 - U
+ Ut = Mt = zeros = matrix(0, nrow=ages, ncol=ages)
+ Ut[row(Ut)-1 == col(Ut)] <- p[-ages]
+ Ut[ages, ages] = p[ages]
+ diag(Mt) = 1 - p
Ut = rbind(cbind(Ut,zeros),
- cbind(Mt,Dcum))
+ cbind(Mt,zeros))
ft = matrix(0, nrow=ages*2, ncol=ages*2)
ft[1,1:ages] = f * birth_female
- # stable age distr
+ # stable age distribution in case no pi is given
if(is.null(pi)){
A = Ut[1:ages,1:ages] + ft[1:ages,1:ages]
A_decomp = eigen(A)
@@ -57,24 +60,20 @@ kin_time_invariant <- function(U = NULL, f = NULL,
ys[,i+1] = Ut %*% ys[,i] + ft %*% m[,i]
nys[,i+1] = Ut %*% nys[,i] + ft %*% ys[,i]
}
-
gm[1:ages,1] = m[1:ages,] %*% pi
for(i in 1:(ages-1)){
gm[,i+1] = Ut %*% gm[,i]
}
-
ggm[1:ages,1] = gm[1:ages,] %*% pi
for(i in 1:(ages-1)){
ggm[,i+1] = Ut %*% ggm[,i]
}
-
os[1:ages,1] = d[1:ages,] %*% pi
nos[1:ages,1] = gd[1:ages,] %*% pi
for(i in 1:(ages-1)){
os[,i+1] = Ut %*% os[,i]
nos[,i+1] = Ut %*% nos[,i] + ft %*% os[,i]
}
-
oa[1:ages,1] = os[1:ages,] %*% pi
ya[1:ages,1] = ys[1:ages,] %*% pi
coa[1:ages,1] = nos[1:ages,] %*% pi
@@ -95,9 +94,12 @@ kin_time_invariant <- function(U = NULL, f = NULL,
kin_list <- kin_list %>% purrr::keep(names(.) %in% output_kin)
}
- # as data.frame
+ # reshape as data.frame
kin <- purrr::map2(kin_list, names(kin_list),
function(x,y){
+ # reassign deaths to Focal experienced age
+ x[(ages+1):(ages*2),1:(ages-1)] <- x[(ages+1):(ages*2),2:ages]
+ x[(ages+1):(ages*2),ages] <- 0
out <- as.data.frame(x)
colnames(out) <- age
out %>%
@@ -111,13 +113,11 @@ kin_time_invariant <- function(U = NULL, f = NULL,
) %>%
purrr::reduce(rbind)
-
# results as list?
if(list_output) {
out <- kin_list
}else{
out <- kin
}
-
return(out)
}
diff --git a/R/kin_time_invariant_2sex.R b/R/kin_time_invariant_2sex.R
new file mode 100644
index 0000000..6f733b6
--- /dev/null
+++ b/R/kin_time_invariant_2sex.R
@@ -0,0 +1,167 @@
+#' Estimate kin counts in a time invariant framework for two-sex model.
+
+#' @description Two-sex matrix framework for kin count estimates.This produces kin counts grouped by kin, age and sex of
+#' each relatives at each Focal´s age. For example, male cousins from aunts and uncles from different sibling's parents
+#' are grouped in one male count of cousins.
+#' @details See Caswell (2022) for details on formulas.
+#' @param pf numeric. A vector of survival probabilities for females with same length as ages.
+#' @param ff numeric. A vector of age-specific fertility rates for females with same length as ages.
+#' @param pm numeric. A vector of survival probabilities for males with same length as ages.
+#' @param fm numeric. A vector of age-specific fertility rates for males with same length as ages.
+#' @param sex_focal character. "f" for female or "m" for male.
+#' @param birth_female numeric. Female portion at birth.
+#' @param pif numeric. For using some specific non-stable age distribution of childbearing for mothers (same length as ages). Default `NULL`.
+#' @param pim numeric. For using some specific non-stable age distribution of childbearing for fathers (same length as ages). Default `NULL`.
+#' @param output_kin character. kin to return, considering matrilineal names. For example "m" for parents, "d" for children, etc. See the `vignette` for all kin types.
+#' @param list_output logical. Results as a list with `output_kin` elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default `FALSE`
+#'
+#' @return A data frame with focal´s age, related ages and type of kin
+#' (for example `d` is children, `oa` is older aunts/uncles, etc.), sex, alive and death. If `list_output = TRUE` then this is a list.
+#' @export
+
+kin_time_invariant_2sex <- function(pf = NULL, pm = NULL,
+ ff = NULL, fm = NULL,
+ sex_focal = "f",
+ birth_female = 1/2.04,
+ pif = NULL, pim = NULL,
+ output_kin = NULL,
+ list_output = FALSE){
+
+ # global vars
+ .<-sex_kin<-alive<-count<-living<-dead<-age_kin<-age_focal<-cohort<-year<-total<-mean_age<-count_living<-sd_age<-count_dead<-mean_age_lost<-indicator<-value<-NULL
+
+ # same input length
+ if(!all(length(pf)==length(pm), length(pf)==length(ff), length(pf)==length(fm))) stop("Lengths of p's and f's should be the same")
+
+ # make matrix transition from vectors. Include death counts with matrix M
+ age = 0:(length(pf)-1)
+ ages = length(age)
+ agess = ages * 2
+ Uf = Um = Ff = Fm = Gt = zeros = matrix(0, nrow=ages, ncol=ages)
+ Uf[row(Uf)-1 == col(Uf)] <- pf[-ages]
+ Uf[ages, ages] = Uf[ages]
+ Um[row(Um)-1 == col(Um)] <- pm[-ages]
+ Um[ages, ages] = Um[ages]
+ Mm <- diag(1-pm)
+ Mf <- diag(1-pf)
+ Ut <- as.matrix(rbind(
+ cbind(Matrix::bdiag(Uf, Um), Matrix::bdiag(zeros, zeros)),
+ cbind(Matrix::bdiag(Mf, Mm), Matrix::bdiag(zeros, zeros))))
+ Ff[1,] = ff
+ Fm[1,] = fm
+ Ft <- Ft_star <- matrix(0, agess*2, agess*2)
+ Ft[1:agess,1:agess] <- rbind(cbind(birth_female * Ff, birth_female * Fm),
+ cbind((1-birth_female) * Ff, (1-birth_female) * Fm))
+
+ # mother and father do not reproduce independently to produce focal´s siblings. Assign to mother
+ Ft_star[1:agess,1:ages] <- rbind(birth_female * Ff, (1-birth_female) * Ff)
+
+ # parents age distribution under stable assumption in case no input
+ if(is.null(pim) | is.null(pif)){
+ A = Matrix::bdiag(Uf, Um) + Ft_star[1:agess,1:agess]
+ A_decomp = eigen(A)
+ lambda = as.double(A_decomp$values[1])
+ w = as.double(A_decomp$vectors[,1])/sum(as.double(A_decomp$vectors[,1]))
+ wf = w[1:ages]
+ wm = w[(ages+1):(2*ages)]
+ pif = wf * ff / sum(wf * ff)
+ pim = wm * fm / sum(wm * fm)
+ }
+
+ # initial count matrix (kin ages in rows and focal age in column)
+ phi = d = gd = ggd = m = gm = ggm = os = ys = nos = nys = oa = ya = coa = cya = matrix(0, agess*2, ages)
+
+ # locate focal at age 0 depending sex
+ sex_index <- ifelse(sex_focal == "f", 1, ages+1)
+ phi[sex_index, 1] <- 1
+
+ # G matrix moves focal by age
+ G <- matrix(0, nrow=ages, ncol=ages)
+ G[row(G)-1 == col(G)] <- 1
+ Gt <- matrix(0, agess*2, agess*2)
+ Gt[1:(agess), 1:(agess)] <- as.matrix(Matrix::bdiag(G, G))
+
+ # focal´s trip
+ # names of matrix count by kin refers to matrilineal as general reference
+ m[1:(agess),1] = c(pif, pim)
+ for(i in 1:(ages-1)){
+ # i = 1
+ phi[,i+1] = Gt %*% phi[,i]
+ d[,i+1] = Ut %*% d[,i] + Ft %*% phi[,i]
+ gd[,i+1] = Ut %*% gd[,i] + Ft %*% d[,i]
+ ggd[,i+1] = Ut %*% ggd[,i] + Ft %*% gd[,i]
+ m[,i+1] = Ut %*% m[,i]
+ ys[,i+1] = Ut %*% ys[,i] + Ft_star %*% m[,i]
+ nys[,i+1] = Ut %*% nys[,i] + Ft %*% ys[,i]
+ }
+
+ gm[1:(agess),1] = m[1:(agess),] %*% (pif + pim)
+ for(i in 1:(ages-1)){
+ gm[,i+1] = Ut %*% gm[,i]
+ }
+
+ ggm[1:(agess),1] = gm[1:(agess),] %*% (pif + pim)
+ for(i in 1:(ages-1)){
+ ggm[,i+1] = Ut %*% ggm[,i]
+ }
+
+
+ # initial conditions on os and nos depends of focal sex
+ pios <- if(sex_focal == "f") pif else pim
+ os[1:(agess),1] = d[1:(agess),] %*% pios
+ nos[1:(agess),1] = gd[1:(agess),] %*% pios
+ for(i in 1:(ages-1)){
+ os[,i+1] = Ut %*% os[,i]
+ nos[,i+1] = Ut %*% nos[,i] + Ft %*% os[,i]
+ }
+
+ # continue
+ oa[1:(agess),1] = os[1:(agess),] %*% (pif + pim)
+ ya[1:(agess),1] = ys[1:(agess),] %*% (pif + pim)
+ coa[1:(agess),1] = nos[1:(agess),] %*% (pif + pim)
+ cya[1:(agess),1] = nys[1:(agess),] %*% (pif + pim)
+ for(i in 1:(ages-1)){
+ oa[,i+1] = Ut %*% oa[,i]
+ ya[,i+1] = Ut %*% ya[,i] + Ft_star %*% gm[,i]
+ coa[,i+1] = Ut %*% coa[,i] + Ft %*% oa[,i]
+ cya[,i+1] = Ut %*% cya[,i] + Ft %*% ya[,i]
+ }
+
+ # get results
+ kin_list <- list(d=d,gd=gd,ggd=ggd,m=m,gm=gm,ggm=ggm,os=os,ys=ys,
+ nos=nos,nys=nys,oa=oa,ya=ya,coa=coa,cya=cya)
+
+ # only selected kin
+ if(!is.null(output_kin)){
+ kin_list <- kin_list %>% purrr::keep(names(.) %in% output_kin)
+ }
+
+ # as data.frame
+ kin <- purrr::map2(kin_list, names(kin_list),
+ function(x,y){
+ # reassign deaths to Focal experienced age
+ x[(agess+1):(agess*2),1:(ages-1)] <- x[(agess+1):(agess*2),2:ages]
+ x[(agess+1):(agess*2),ages] <- 0
+ out <- as.data.frame(x)
+ colnames(out) <- age
+ out %>%
+ dplyr::mutate(kin = y,
+ age_kin = rep(age,4),
+ sex_kin = rep(c(rep("f",ages), rep("m",ages)),2),
+ alive = c(rep("living",2*ages), rep("dead",2*ages))) %>%
+ tidyr::pivot_longer(c(-age_kin, -kin, -sex_kin, -alive), names_to = "age_focal", values_to = "count") %>%
+ dplyr::mutate(age_focal = as.integer(age_focal)) %>%
+ tidyr::pivot_wider(names_from = alive, values_from = count)
+ }
+ ) %>%
+ purrr::reduce(rbind)
+
+ # results as list?
+ if(list_output) {
+ out <- kin_list
+ }else{
+ out <- kin
+ }
+
+ return(out)
+}
diff --git a/R/kin_time_invariant_2sex_cod.R b/R/kin_time_invariant_2sex_cod.R
new file mode 100644
index 0000000..e0d17d6
--- /dev/null
+++ b/R/kin_time_invariant_2sex_cod.R
@@ -0,0 +1,255 @@
+#' Estimate kin counts in a time invariant framework for two-sex model.
+
+#' @description Two-sex matrix framework for kin count and death estimates.This produces kin counts grouped by kin, age and sex of
+#' each relatives at each Focal´s age. For example, male cousins from aunts and uncles from different sibling's parents
+#' are grouped in one male count of cousins. This also produces kin deaths grouped by kin, age, sex of
+#' each relatives at each Focal´s age, and cause of death.
+#' @details See Caswell (2022) for details on formulas.
+#' @param pf numeric. A vector of survival probabilities for females with same length as ages.
+#' @param Hf numeric. A matrix with cause-specific hazards for females with rows as causes and columns as ages, being the name of each col the age.
+#' @param ff numeric. A vector of age-specific fertility rates for females with same length as ages.
+#' @param pm numeric. A vector of survival probabilities for males with same length as ages.
+#' @param fm numeric. A vector of age-specific fertility rates for males with same length as ages.
+#' @param Hm numeric. A matrix with cause-specific hazards for males with rows as causes and columns as ages, being the name of each col the age.
+#' @param sex_focal character. "f" for female or "m" for male.
+#' @param birth_female numeric. Female portion at birth.
+#' @param pif numeric. For using some specific non-stable age distribution of childbearing for mothers (same length as ages). Default `NULL`.
+#' @param pim numeric. For using some specific non-stable age distribution of childbearing for fathers (same length as ages). Default `NULL`.
+#' @param output_kin character. kin to return, considering matrilineal names. For example "m" for parents, "d" for children, etc. See the `vignette` for all kin types.
+#' @param list_output logical. Results as a list with `output_kin` elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default `FALSE`
+#'
+#' @return A data frame with focal´s age, related ages and type of kin
+#' (for example `d` is children, `oa` is older aunts/uncles, etc.), sex, alive and death. If `list_output = TRUE` then this is a list.
+#' @export
+
+# BEN: Added hazard matrices as inputs.
+# Assume that input of cause-specific mortality will be in terms of
+# matrices of cause-specific hazards for the two sexes (causes * ages).
+# Alternative: a matrix (causes * ages) containing the ratio mxi/mx.
+kin_time_invariant_2sex_cod <- function(pf = NULL,
+ pm = NULL,
+ ff = NULL,
+ fm = NULL,
+ Hf = NULL,
+ Hm = NULL,
+ sex_focal = "f",
+ birth_female = 1 / 2.04,
+ pif = NULL,
+ pim = NULL,
+ output_kin = NULL,
+ list_output = FALSE) {
+
+
+ # global vars
+ .<-sex_kin<-alive<-count<-living<-dead<-age_kin<-age_focal<-cohort<-year<-total<-mean_age<-count_living<-sd_age<-count_dead<-mean_age_lost<-indicator<-value<-NULL
+
+ # same input length
+
+ # BEN: Now we should also check the dimensions of the cause-specific hazard
+ # matrices.
+ if(!all(length(pf)==length(pm), length(pf)==length(ff), length(pf)==length(fm),
+ nrow(Hf)==nrow(Hm), ncol(Hf)==ncol(Hm), ncol(Hf)==length(pf))) stop("Number of age groups of p's, h's, and f's should match")
+
+ # make matrix transition from vectors. Include death counts with matrix M
+ age = 0:(length(pf)-1)
+ ages = length(age)
+ agess = ages * 2
+ Uf = Um = Ff = Fm = Gt = matrix(0, nrow=ages, ncol=ages)
+
+ # BEN: The zero matrix was deleted from line above and has
+ # to be made specific according to living/dead kin
+ # part of the block matrix Ut.
+ causes <- nrow(Hf) # number of causes of death
+ zeros_l <- matrix(0, nrow = ages, ncol = (causes*ages)) # zero matrix for living kin part
+ zeros_d = matrix(0, nrow = (causes*ages), ncol = (causes*ages)) # zero matrix for death kin part
+
+ Uf[row(Uf)-1 == col(Uf)] <- pf[-ages]
+
+ # BEN: What is the purpose of the following line? By default it is zero due to
+ # how the matrix is created
+ Uf[ages, ages] = Uf[ages]
+
+ Um[row(Um)-1 == col(Um)] <- pm[-ages]
+ Um[ages, ages] = Um[ages]
+
+ # BEN: Building of M, matrix of cause-specific prob. of dying.
+ # Hence, M = H D(h_tilde)^{-1} D(q)
+ # where h_tilde are the summed hazards for each age, and
+ # q = 1 - p
+ sum_hf <- t(rep(1, causes)) %*% Hf # h_tilde female
+ sum_hm <- t(rep(1, causes)) %*% Hm # h_tilde male
+ Mf <- Hf %*% solve(diag(c(sum_hf))) %*% diag(1-pf)
+ Mm <- Hm %*% solve(diag(c(sum_hm))) %*% diag(1-pm)
+ # Mm <- diag(1-pm)
+ # Mf <- diag(1-pf)
+
+ # BEN: In order to classify kin death by both cause and age at death,
+ # we need a mortality matrices M_hat of dimension
+ # ((causes*ages) * ages). See eq.12 in Caswell et al. (2024).
+ # Store columns of M as a list of vectors
+ Mf.cols <- lapply(1:ncol(Mf), function(j) return(Mf[,j]))
+ Mm.cols <- lapply(1:ncol(Mm), function(j) return(Mm[,j]))
+ # Create M_hat using the vectors as elements of the block diagonal
+ Ut <- as.matrix(rbind(
+ cbind(Matrix::bdiag(Uf, Um), Matrix::bdiag(zeros_l, zeros_l)),
+ cbind(Matrix::bdiag(Matrix::bdiag(Mf.cols), Matrix::bdiag(Mm.cols)), Matrix::bdiag(zeros_d, zeros_d))))
+
+ Ff[1,] = ff
+ Fm[1,] = fm
+
+ # BEN: Accounting for causes of death leads to have different dimensions
+ # in Ft and Ft_star.
+ Ft <- Ft_star <- matrix(0, (agess + agess*causes), (agess + agess*causes))
+ Ft[1:agess,1:agess] <- rbind(cbind(birth_female * Ff, birth_female * Fm),
+ cbind((1-birth_female) * Ff, (1-birth_female) * Fm))
+
+ # mother and father do not reproduce independently to produce focal´s siblings. Assign to mother
+ Ft_star[1:agess,1:ages] <- rbind(birth_female * Ff, (1-birth_female) * Ff)
+
+ # parents age distribution under stable assumption in case no input
+ if(is.null(pim) | is.null(pif)){
+ A = Matrix::bdiag(Uf, Um) + Ft_star[1:agess,1:agess]
+ A_decomp = eigen(A)
+ lambda = as.double(A_decomp$values[1])
+ w = as.double(A_decomp$vectors[,1])/sum(as.double(A_decomp$vectors[,1]))
+ wf = w[1:ages]
+ wm = w[(ages+1):(2*ages)]
+ pif = wf * ff / sum(wf * ff)
+ pim = wm * fm / sum(wm * fm)
+ }
+
+ # initial count matrix (kin ages in rows and focal age in column)
+ # BEN: Changed dimensions of lower part (dead kin) to account for death from causes.
+ phi = d = gd = ggd = m = gm = ggm = os = ys = nos = nys = oa = ya = coa = cya = matrix(0, (agess + agess*causes), ages)
+
+ # locate focal at age 0 depending sex
+ sex_index <- ifelse(sex_focal == "f", 1, ages+1)
+ phi[sex_index, 1] <- 1
+
+ # G matrix moves focal by age
+ G <- matrix(0, nrow=ages, ncol=ages)
+ G[row(G)-1 == col(G)] <- 1
+
+ # BEN: Changed dimensions
+ Gt <- matrix(0, (agess + agess*causes), (agess + agess*causes))
+
+ Gt[1:(agess), 1:(agess)] <- as.matrix(Matrix::bdiag(G, G))
+
+ # focal´s trip
+ # names of matrix count by kin refers to matrilineal as general reference
+ m[1:(agess),1] = c(pif, pim)
+ for(i in 1:(ages-1)){
+ # i = 1
+ phi[,i+1] = Gt %*% phi[,i]
+ d[,i+1] = Ut %*% d[,i] + Ft %*% phi[,i]
+ gd[,i+1] = Ut %*% gd[,i] + Ft %*% d[,i]
+ ggd[,i+1] = Ut %*% ggd[,i] + Ft %*% gd[,i]
+ m[,i+1] = Ut %*% m[,i]
+ ys[,i+1] = Ut %*% ys[,i] + Ft_star %*% m[,i]
+ nys[,i+1] = Ut %*% nys[,i] + Ft %*% ys[,i]
+ }
+
+ gm[1:(agess),1] = m[1:(agess),] %*% (pif + pim)
+ for(i in 1:(ages-1)){
+ gm[,i+1] = Ut %*% gm[,i]
+ }
+
+ ggm[1:(agess),1] = gm[1:(agess),] %*% (pif + pim)
+ for(i in 1:(ages-1)){
+ ggm[,i+1] = Ut %*% ggm[,i]
+ }
+
+ os[1:(agess),1] = d[1:(agess),] %*% pif
+ nos[1:(agess),1] = gd[1:(agess),] %*% pif
+ for(i in 1:(ages-1)){
+ os[,i+1] = Ut %*% os[,i]
+ nos[,i+1] = Ut %*% nos[,i] + Ft %*% os[,i]
+ }
+
+ oa[1:(agess),1] = os[1:(agess),] %*% (pif + pim)
+ ya[1:(agess),1] = ys[1:(agess),] %*% (pif + pim)
+ coa[1:(agess),1] = nos[1:(agess),] %*% (pif + pim)
+ cya[1:(agess),1] = nys[1:(agess),] %*% (pif + pim)
+ for(i in 1:(ages-1)){
+ oa[,i+1] = Ut %*% oa[,i]
+ ya[,i+1] = Ut %*% ya[,i] + Ft_star %*% gm[,i]
+ coa[,i+1] = Ut %*% coa[,i] + Ft %*% oa[,i]
+ cya[,i+1] = Ut %*% cya[,i] + Ft %*% ya[,i]
+ }
+
+ # get results
+ kin_list <- list(d=d,gd=gd,ggd=ggd,m=m,gm=gm,ggm=ggm,os=os,ys=ys,
+ nos=nos,nys=nys,oa=oa,ya=ya,coa=coa,cya=cya)
+
+ # only selected kin
+ if(!is.null(output_kin)){
+ kin_list <- kin_list %>% purrr::keep(names(.) %in% output_kin)
+ }
+
+ # as data.frame
+ kin <- purrr::map2(kin_list, names(kin_list),
+ function(x,y){
+
+ # BEN: Death take place in the same year and age!
+ # I adapted the code
+ # below such that it works with the new dimensions.
+
+ # reassign deaths to Focal experienced age
+ x[(agess+1):(agess + agess*causes),1:(ages-1)] <- x[(agess+1):(agess + agess*causes),2:ages]
+ x[(agess+1):(agess + agess*causes),ages] <- 0
+ out <- as.data.frame(x)
+ colnames(out) <- age
+ out %>%
+ # BEN: the matrices have different dimensions when
+ # we accounf for causes of death so what follows
+ # has been substantially changed.
+ dplyr::mutate(kin = y,
+ age_kin = c(rep(age,2), rep(rep(age,each=causes),2)),
+ sex_kin = c(rep(c("f", "m"),each=ages), rep(c("f", "m"),each=ages*causes)),
+ alive = c(rep("living",2*ages), rep(paste0("deadcause",1:causes),2*ages))) %>%
+ tidyr::pivot_longer(c(-age_kin, -kin, -sex_kin, -alive), names_to = "age_focal", values_to = "count") %>%
+ dplyr::mutate(age_focal = as.integer(age_focal)) %>%
+ tidyr::pivot_wider(names_from = alive, values_from = count)
+ }
+ ) %>%
+ purrr::reduce(rbind)
+
+ # results as list?
+ if(list_output) {
+ out <- kin_list
+ }else{
+ out <- kin
+ }
+
+ return(out)
+}
+
+## BEN: ========================================================================
+
+# Checks
+
+# No dead parent at birth: deadcausei=0 when age_focal==0
+# ff # fertility starts at age 13
+# kin |> filter(kin == "m", age_focal ==0, age_kin >= 12)
+#
+# # pi when age_focal==0 and age_kin when fx>0:
+# kin |> filter(kin == "m", age_kin >= 13, age_focal ==0)
+# pif[14:101]
+#
+# # mother dying from cause i at age x when focal is age==1 comes from nber of
+# # living mother age x when focal is age==1 multiplied by (1-pf[x])*(1/3)
+# kin |> filter(kin == "m", age_kin == 14, age_focal ==1)
+# 0.000246 * ((1-pf[15])*(1/3)) # mother
+# 0.0000486 * ((1-pm[15])*(1/3)) # father
+#
+# # Store to compare with kin_time_invariant_2sex.R
+# saveRDS(
+# kin,
+# here(
+# "checks",
+# "output_time_invariant_2sex.rds"
+# )
+# )
+
+
+## =============================================================================
diff --git a/R/kin_time_variant.R b/R/kin_time_variant.R
index bc962fc..0853b05 100644
--- a/R/kin_time_variant.R
+++ b/R/kin_time_variant.R
@@ -1,10 +1,10 @@
-#' Estimate kin counts in a time variant framework
+#' Estimate kin counts in a time variant framework (dynamic rates) for one-sex model (matrilineal/patrilineal)
-#' @description Implementation of time variant Goodman-Keyfitz-Pullum equations based on Caswell (2021).
-#'
-#' @param U numeric. A matrix of survival ratios with rows as ages and columns as years. Column names must be equal interval.
+#' @description Matrix implementation of time variant Goodman-Keyfitz-Pullum equations in a matrix framework.
+#' @details See Caswell (2021) for details on formulas.
+#' @param p numeric. A matrix of survival ratios with rows as ages and columns as years. Column names must be equal interval.
#' @param f numeric. A matrix of age-specific fertility rates with rows as ages and columns as years. Coincident with `U`.
-#' @param N numeric. A matrix of population with rows as ages and columns as years. Coincident with `U`.
+#' @param n numeric. A matrix of population with rows as ages and columns as years. Coincident with `U`.
#' @param pi numeric. A matrix with distribution of childbearing with rows as ages and columns as years. Coincident with `U`.
#' @param output_cohort integer. Year of birth of focal to return as output. Could be a vector. Should be within input data years range.
#' @param output_period integer. Year for which to return kinship structure. Could be a vector. Should be within input data years range.
@@ -12,82 +12,80 @@
#' @param birth_female numeric. Female portion at birth.
#' @param list_output logical. Results as a list with years elements (as a result of `output_cohort` and `output_period` combination), with a second list of `output_kin` elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default `FALSE`
-#' @return A data frame of population kinship structure, with focal's cohort, focal´s age, period year, type of relatives
+#' @return A data frame of population kinship structure, with Focal's cohort, focal´s age, period year, type of relatives
#' (for example `d` is daughter, `oa` is older aunts, etc.), living and death kin counts, and age of (living or time deceased) relatives. If `list_output = TRUE` then this is a list.
#' @export
-kin_time_variant <- function(U = NULL, f = NULL, N = NULL, pi = NULL,
+kin_time_variant <- function(p = NULL, f = NULL, pi = NULL, n = NULL,
output_cohort = NULL, output_period = NULL, output_kin = NULL,
birth_female = 1/2.04, list_output = FALSE){
+ # global vars
+ .<-living<-dead<-age_kin<-age_focal<-cohort<-year<-total<-mean_age<-count_living<-sd_age<-count_dead<-mean_age_lost<-indicator<-value<-NULL
+
# check input
- if(is.null(U) | is.null(f)) stop("You need values on U and/or f.")
+ if(is.null(p) | is.null(f)) stop("You need values on p and f.")
# diff years
- if(!any(as.integer(colnames(U)) == as.integer(colnames(f)))) stop("Data should be from same years.")
+ if(!any(as.integer(colnames(p)) == as.integer(colnames(f)))) stop("Make sure that p and f are matrices and have the same column names.")
# data should be from same interval years
- years_data <- as.integer(colnames(U))
- if(var(diff(years_data))!=0) stop("Data should be for same interval length years. Fill the gaps and run again")
+ years_data <- as.integer(colnames(p))
+ if(stats::var(diff(years_data))!=0) stop("The years given as column names in the p and f matrices must be equally spaced.")
# utils
- age <- 0:(nrow(U)-1)
+ age <- 0:(nrow(p)-1)
n_years_data <- length(years_data)
ages <- length(age)
om <- max(age)
zeros <- matrix(0, nrow=ages, ncol=ages)
- # age distribution at childborn
+ # consider input data for age distribution at child born, or flag it
+ no_Pi <- FALSE
if(is.null(pi)){
- if(is.null(N)){
+ if(is.null(n)){
# create pi and fill it during the loop
- message("Stable assumption was made for calculating pi on each year because no input data.")
+ no_Pi <- TRUE
pi <- matrix(0, nrow=ages, ncol=n_years_data)
}else{
- pi <- rbind(t(t(N * f)/colSums(N * f)), matrix(0,ages,length(years_data)))
+ no_Pi <- FALSE
+ pi <- rbind(t(t(n * f)/colSums(n * f)), matrix(0,ages,length(years_data)))
}
}
- # get lists of matrix
- Ul = fl = list()
- for(t in 1:n_years_data){
- Ut = Mt = Dcum = matrix(0, nrow=ages, ncol=ages)
- Ut[row(Ut)-1 == col(Ut)] <- U[-ages,t]
- Ut[ages, ages]=U[ages,t]
- diag(Mt) = 1 - U[,t]
- Ul[[as.character(years_data[t])]] <- rbind(cbind(Ut,zeros),cbind(Mt,Dcum))
- ft = matrix(0, nrow=ages*2, ncol=ages*2)
- ft[1,1:ages] = f[,t] * birth_female
- fl[[as.character(years_data[t])]] <- ft
- }
- U <- Ul
- f <- fl
-
- # loop over years (more performance here)
+ # loop over years
kin_all <- list()
pb <- progress::progress_bar$new(
format = "Running over input years [:bar] :percent",
- total = n_years_data, clear = FALSE, width = 60)
- for (iyear in 1:n_years_data){
- # print(iyear)
- Ut <- as.matrix(U[[iyear]])
- ft <- as.matrix(f[[iyear]])
- if(is.null(pi)){
- A <- Ut[1:ages,1:ages] + ft[1:ages,1:ages]
- A_decomp = eigen(A)
+ total = n_years_data + 1, clear = FALSE, width = 50)
+ for (t in 1:n_years_data){
+ # build set of matrix
+ Ut <- Mt <- matrix(0, nrow=ages, ncol=ages)
+ Ut[row(Ut)-1 == col(Ut)] <- p[-ages,t]
+ Ut[ages, ages] <- p[ages,t]
+ diag(Mt) <- 1 - p[,t]
+ Ut <- rbind(cbind(Ut,zeros),cbind(Mt,zeros))
+ ft <- matrix(0, nrow=ages*2, ncol=ages*2)
+ ft[1,1:ages] <- f[,t] * birth_female
+ A <- Ut[1:ages,1:ages] + ft[1:ages,1:ages]
+ # stable assumption at start
+ if (t==1){
+ p1 <- c(diag(Ut[-1,])[1:om],Ut[om,om])
+ f1 <- ft[1,][1:ages]/birth_female
+ A_decomp <- eigen(A)
w <- as.double(A_decomp$vectors[,1])/sum(as.double(A_decomp$vectors[,1]))
- pit <- pi[,iyear] <- w*A[1,]/sum(w*A[1,])
- }else{
- pit <- pi[,iyear]
- }
- if (iyear==1){
- U1 <- c(diag(Ut[-1,])[1:om],Ut[om,om])
- f1 <- ft[1,][1:ages]
+ pit <- w*A[1,]/sum(w*A[1,])
pi1 <- pit[1:ages]
- kin_all[[1]] <- kin_time_invariant(U = U1, f = f1/birth_female, pi = pi1, birth_female = birth_female,
+ kin_all[[1]] <- kin_time_invariant(p = p1, f = f1, pi = pi1, birth_female = birth_female,
list_output = TRUE)
}
- kin_all[[iyear+1]] <- timevarying_kin(Ut=Ut,ft=ft,pit=pit,ages,pkin=kin_all[[iyear]])
+ # project pi
+ if(no_Pi){
+ w <- A %*% w
+ pi[,t] <- w*A[1,]/sum(w*A[1,])
+ }
+ # kin for next year
+ kin_all[[t+1]] <- timevarying_kin(Ut = Ut, ft = ft, pit = pi[,t], ages, pkin = kin_all[[t]])
pb$tick()
}
@@ -96,7 +94,6 @@ kin_time_variant <- function(U = NULL, f = NULL, N = NULL, pi = NULL,
# combinations to return
out_selected <- output_period_cohort_combination(output_cohort, output_period, age = age, years_data = years_data)
-
possible_kin <- c("d","gd","ggd","m","gm","ggm","os","ys","nos","nys","oa","ya","coa","cya")
if(is.null(output_kin)){
selected_kin_position <- 1:length(possible_kin)
@@ -110,23 +107,29 @@ kin_time_variant <- function(U = NULL, f = NULL, N = NULL, pi = NULL,
purrr::map(~ .[selected_kin_position])
# long format
- kin <- lapply(names(kin_list), function(Y){
+ message("Preparing output...")
+ kin <- lapply(names(kin_list), FUN = function(Y){
X <- kin_list[[Y]]
- X <- purrr::map2(X, names(X), function(x,y) as.data.frame(x) %>%
- dplyr::mutate(year = Y,
- kin=y,
- age_kin = rep(age,2),
- alive = c(rep("living",ages), rep("dead",ages)),
- .before=everything())) %>%
- dplyr::bind_rows() %>%
- stats::setNames(c("year","kin","age_kin","alive",as.character(age))) %>%
- tidyr::gather(age_focal, count,-age_kin, -kin, -year, -alive) %>%
- dplyr::mutate(age_focal = as.integer(age_focal),
- year = as.integer(year),
- cohort = year - age_focal) %>%
- dplyr::filter(age_focal %in% out_selected$age[out_selected$year==as.integer(Y)]) %>%
- tidyr::pivot_wider(names_from = alive, values_from = count)}) %>%
- dplyr::bind_rows()
+ X <- purrr::map2(X, names(X), function(x,y){
+ # reassign deaths to Focal experienced age
+ x[(ages+1):(ages*2),1:(ages-1)] <- x[(ages+1):(ages*2),2:ages]
+ x[(ages+1):(ages*2),ages] <- 0
+ x <- as.data.frame(x)
+ x$year <- Y
+ x$kin <- y
+ x$age_kin <- rep(age,2)
+ x$alive <- c(rep("living",ages), rep("dead",ages))
+ return(x)
+ }) %>%
+ data.table::rbindlist() %>%
+ stats::setNames(c(as.character(age), "year","kin","age_kin","alive")) %>%
+ data.table::melt(id.vars = c("year","kin","age_kin","alive"), variable.name = "age_focal", value.name = "count")
+ X$age_focal = as.integer(as.character(X$age_focal))
+ X$year = as.integer(X$year)
+ X$cohort = X$year - X$age_focal
+ X[X$age_focal %in% out_selected$age[out_selected$year==as.integer(Y)],] %>%
+ data.table::dcast(year + kin + age_kin + age_focal + cohort ~ alive, value.var = "count")
+ }) %>% data.table::rbindlist()
# results as list?
if(list_output) {
@@ -135,6 +138,7 @@ kin_time_variant <- function(U = NULL, f = NULL, N = NULL, pi = NULL,
out <- kin
}
+ # end
return(out)
}
@@ -148,31 +152,33 @@ kin_time_variant <- function(U = NULL, f = NULL, N = NULL, pi = NULL,
#' @param pit numeric. A matrix with distribution of childbearing.
#' @param ages numeric.
#' @param pkin numeric. A list with kin count distribution in previous year.
-#
+#' @return A list of 14 types of kin matrices (kin age by Focal age) projected one time interval.
+#' @export
timevarying_kin<- function(Ut, ft, pit, ages, pkin){
# frequently used zero vector for initial condition
- zvec=rep(0,ages*2);
- I = matrix(0, ages * 2, ages * 2)
- diag(I[1:ages,1:ages]) = 1
- om=ages-1;
- d = gd = ggd = m = gm = ggm = os = ys = nos = nys = oa = ya = coa = cya = matrix(0,ages*2,ages)
+ zvec <- rep(0,ages*2);
+ I <- matrix(0, ages * 2, ages * 2)
+ diag(I[1:ages,1:ages]) <- 1
+ om <- ages-1;
+ d = gd = ggd = m = gm = ggm = os = ys = nos = nys = oa = ya = coa = cya <- matrix(0,ages*2,ages)
kin_list <- list(d=d,gd=gd,ggd=ggd,m=m,gm=gm,ggm=ggm,os=os,ys=ys,
nos=nos,nys=nys,oa=oa,ya=ya,coa=coa,cya=cya)
# initial distribution
- d[,1]=gd[,1]=ggd[,1]=ys[,1]=nys[,1]=zvec
- m[1:ages,1] = pit[1:ages]
- gm[1:ages,1] = pkin[["m"]][1:ages,] %*% pit[1:ages]
- ggm[1:ages,1]= pkin[["gm"]][1:ages,] %*% pit[1:ages]
- os[1:ages,1] = pkin[["d"]][1:ages,] %*% pit[1:ages]
+ d[,1] = gd[,1] = ggd[,1] = ys[,1] = nys[,1] = zvec
+ m[1:ages,1] = pit[1:ages]
+ gm[1:ages,1] = pkin[["m"]][1:ages,] %*% pit[1:ages]
+ ggm[1:ages,1] = pkin[["gm"]][1:ages,] %*% pit[1:ages]
+ os[1:ages,1] = pkin[["d"]][1:ages,] %*% pit[1:ages]
nos[1:ages,1] = pkin[["gd"]][1:ages,] %*% pit[1:ages]
- oa[1:ages,1] = pkin[["os"]][1:ages,] %*% pit[1:ages]
- ya[1:ages,1] = pkin[["ys"]][1:ages,] %*% pit[1:ages]
- coa[1:ages,1]= pkin[["nos"]][1:ages,] %*% pit[1:ages]
- cya[1:ages,1]= pkin[["nys"]][1:ages,] %*% pit[1:ages]
+ oa[1:ages,1] = pkin[["os"]][1:ages,] %*% pit[1:ages]
+ ya[1:ages,1] = pkin[["ys"]][1:ages,] %*% pit[1:ages]
+ coa[1:ages,1] = pkin[["nos"]][1:ages,] %*% pit[1:ages]
+ cya[1:ages,1] = pkin[["nys"]][1:ages,] %*% pit[1:ages]
- for (ix in 1:om){
+ # focal´s trip
+ for(ix in 1:om){
d[,ix+1] = Ut %*% pkin[["d"]][,ix] + ft %*% I[,ix]
gd[,ix+1] = Ut %*% pkin[["gd"]][,ix] + ft %*% pkin[["d"]][,ix]
ggd[,ix+1] = Ut %*% pkin[["ggd"]][,ix] + ft %*% pkin[["gd"]][,ix]
@@ -195,10 +201,17 @@ timevarying_kin<- function(Ut, ft, pit, ages, pkin){
return(kin_list)
}
-#' defince apc combination to return
+#' APC combination to return
-#' @description defince apc to return.
-#'
+#' @description define APC combination to return in `kin` and `kin2sex`.
+#' @details Because returning all period and cohort data from a huge time-series would be hard memory consuming,
+#' this function is an auxiliary one to deal with selection from inputs `output_cohort` and `output_period`.
+#' @param output_cohort integer. A vector with selected calendar years.
+#' @param output_period integer. A vector with selected cohort years.
+#' @param age integer. A vector with ages from the kinship network to be filtered.
+#' @param years_data integer. A vector with years from the time-varying kinship network to be filtered.
+#' @return data.frame with years and ages to filter in `kin` and `kin_2sex` functions.
+#' @export
output_period_cohort_combination <- function(output_cohort = NULL, output_period = NULL, age = NULL, years_data = NULL){
# no specific
@@ -214,10 +227,11 @@ output_period_cohort_combination <- function(output_cohort = NULL, output_period
unlist(use.names = F))
}else{selected_cohorts_year_age <- c()}
- # period year combination
+ # period combination
if(!is.null(output_period)){selected_years_age <- expand.grid(age, output_period) %>% dplyr::rename(age=1,year=2)
}else{selected_years_age <- c()}
# end
return(dplyr::bind_rows(selected_years_age,selected_cohorts_year_age) %>% dplyr::distinct())
}
+
diff --git a/R/kin_time_variant_2sex.R b/R/kin_time_variant_2sex.R
new file mode 100644
index 0000000..7d76c09
--- /dev/null
+++ b/R/kin_time_variant_2sex.R
@@ -0,0 +1,259 @@
+#' Estimate kin counts in a time variant framework (dynamic rates) in a two-sex framework (Caswell, 2022)
+
+#' @description Two-sex matrix framework for kin count estimates with varying rates.
+#' This produces kin counts grouped by kin, age and sex of each relatives at each Focal´s age.
+#' For example, male cousins from aunts and uncles from different sibling's parents are grouped in one male count of cousins.
+#' @details See Caswell (2022) for details on formulas.
+#' @param pf numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).
+#' @param pm numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).
+#' @param ff numeric. Same as pf but for fertility rates.
+#' @param fm numeric. Same as pm but for fertility rates.
+#' @param sex_focal character. "f" for female or "m" for male.
+#' @param pif numeric. For using some specific age distribution of childbearing for mothers (same length as ages). Default `NULL`.
+#' @param pim numeric. For using some specific age distribution of childbearing for fathers (same length as ages). Default `NULL`.
+#' @param nf numeric. Same as pf but for population distribution (counts or `%`). Optional.
+#' @param nm numeric. Same as pm but for population distribution (counts or `%`). Optional.
+#' @param output_cohort integer. Vector of year cohorts for returning results. Should be within input data years range.
+#' @param output_period integer. Vector of period years for returning results. Should be within input data years range.
+#' @param output_kin character. kin types to return: "m" for mother, "d" for daughter,...
+#' @param birth_female numeric. Female portion at birth. This multiplies `f` argument. If `f` is already for female offspring, this needs to be set as 1.
+#' @param list_output logical. Results as a list with years elements (as a result of `output_cohort` and `output_period` combination), with a second list of `output_kin` elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default `FALSE`
+#' @return A data.frame with year, cohort, Focal´s age, related ages, sex and type of kin (for example `d` is daughter, `oa` is older aunts, etc.), including living and dead kin at that age and sex.
+#' @export
+
+kin_time_variant_2sex <- function(pf = NULL, pm = NULL,
+ ff = NULL, fm = NULL,
+ sex_focal = "f",
+ birth_female = 1/2.04,
+ pif = NULL, pim = NULL,
+ nf = NULL, nm = NULL,
+ output_cohort = NULL, output_period = NULL, output_kin = NULL,
+ list_output = FALSE){
+
+ # global vars
+ .<-living<-dead<-age_kin<-age_focal<-cohort<-year<-total<-mean_age<-count_living<-sd_age<-count_dead<-mean_age_lost<-indicator<-value<-NULL
+
+ # same input length
+ if(!all(dim(pf) == dim(pm), dim(pf) == dim(ff), dim(pf) == dim(fm))) stop("Dimension of P's and F's should be the same")
+
+ # data should be from same interval years
+ years_data <- as.integer(colnames(pf))
+ if(stats::var(diff(years_data))!=0) stop("Data should be for same interval length years. Fill the gaps and run again")
+
+ # utils
+ age <- 0:(nrow(pf)-1)
+ n_years_data <- length(years_data)
+ ages <- length(age)
+ agess <- ages*2
+ om <- max(age)
+ zeros <- matrix(0, nrow=ages, ncol=ages)
+
+ # consider input data for age distribution at child born, or flag it to fill it
+ Pif <- pif; no_Pif <- FALSE
+ if(is.null(pif)){
+ if(!is.null(nf)){
+ Pif <- t(t(nf * ff)/colSums(nf * ff))
+ }else{
+ Pif <- matrix(0, nrow=ages, ncol=n_years_data)
+ no_Pif <- TRUE
+ }
+ }
+ Pim <- pim; no_Pim <- FALSE
+ if(is.null(pim)){
+ if(!is.null(nm)){
+ Pim <- t(t(nm * fm)/colSums(nm * fm))
+ }else{
+ Pim <- matrix(0, nrow=ages, ncol=n_years_data)
+ no_Pim <- TRUE
+ }
+ }
+
+ # get lists of matrix
+ Ul <- Fl <- Fl_star <- list()
+ kin_all <- list()
+ pb <- progress::progress_bar$new(
+ format = "Running over input years [:bar] :percent",
+ total = n_years_data + 1, clear = FALSE, width = 60)
+ for(t in 1:n_years_data){
+ # t = 1
+ Uf = Um = Fft = Fmt = Mm = Mf = Gt = zeros <- matrix(0, nrow=ages, ncol=ages)
+ Uf[row(Uf)-1 == col(Uf)] <- pf[-ages,t]
+ Uf[ages, ages] = pf[ages,t]
+ Um[row(Um)-1 == col(Um)] <- pm[-ages,t]
+ Um[ages, ages] <- pm[ages,t]
+ Mm <- diag(1-pm[,t])
+ Mf <- diag(1-pf[,t])
+ Ut <- as.matrix(rbind(
+ cbind(Matrix::bdiag(Uf, Um), Matrix::bdiag(zeros, zeros)),
+ cbind(Matrix::bdiag(Mf, Mm), Matrix::bdiag(zeros, zeros))))
+ Ul[[as.character(years_data[t])]] <- Ut
+ Fft[1,] <- ff[,t]
+ Fmt[1,] <- fm[,t]
+ Ft <- Ft_star <- matrix(0, agess*2, agess*2)
+ Ft[1:agess,1:agess] <- rbind(cbind(birth_female * Fft, birth_female * Fmt),
+ cbind((1-birth_female) * Fft, (1-birth_female) * Fmt))
+ Ft_star[1:agess,1:ages] <- rbind(birth_female * Fft, (1-birth_female) * Fft)
+ Fl[[as.character(years_data[t])]] <- Ft
+ Fl_star[[as.character(years_data[t])]] <- Ft_star
+ A <- Matrix::bdiag(Uf, Um) + Ft_star[1:agess,1:agess]
+
+ # project
+ Ut <- as.matrix(Ul[[t]])
+ Ft <- as.matrix(Fl[[t]])
+ Ft_star <- as.matrix(Fl_star[[t]])
+
+ # stable assumption at start
+ if (t==1){
+ p1f <- pf[,1]; p1m <- pm[,1]
+ f1f <- ff[,1]; f1m <- fm[,1]
+ # time boundary for pi
+ A_decomp <- eigen(A)
+ lambda <- as.double(A_decomp$values[1])
+ w <- as.double(A_decomp$vectors[,1])/sum(as.double(A_decomp$vectors[,1]))
+ wf <- w[1:ages]
+ wm <- w[(ages+1):(2*ages)]
+ pif1 <- wf * ff[,t] / sum(wf * ff[,t])
+ pim1 <- wm * fm[,t] / sum(wm * fm[,t])
+ kin_all[[1]] <- kin_time_invariant_2sex(pf = p1f, pm = p1m,
+ ff = f1f, fm = f1m,
+ sex_focal = sex_focal,
+ pif = pif1, pim = pim1,
+ birth_female = birth_female, list_output = TRUE)
+ }
+ # project pi
+ if(no_Pim | no_Pif){
+ w <- A %*% w
+ wf <- w[1:ages]
+ wm <- w[(ages+1):(2*ages)]
+ Pif[,t] <- wf * ff[,t] / sum(wf * ff[,t])
+ Pim[,t] <- wm * fm[,t] / sum(wm * fm[,t])
+ }
+ pit <- c(Pif[,t], Pim[,t])
+
+ # kin for next year
+ kin_all[[t+1]] <- timevarying_kin_2sex(Ut = Ut, Ft = Ft, Ft_star = Ft_star,
+ pit = pit, sex_focal, ages, pkin = kin_all[[t]])
+ pb$tick()
+ }
+
+ # filter years and kin that were selected
+ names(kin_all) <- as.character(years_data)
+
+ # combinations to return
+ out_selected <- output_period_cohort_combination(output_cohort, output_period, age = age, years_data = years_data)
+
+ possible_kin <- c("d","gd","ggd","m","gm","ggm","os","ys","nos","nys","oa","ya","coa","cya")
+ if(is.null(output_kin)){
+ selected_kin_position <- 1:length(possible_kin)
+ }else{
+ selected_kin_position <- which(possible_kin %in% output_kin)
+ }
+
+ # first filter
+ kin_list <- kin_all %>%
+ purrr::keep(names(.) %in% as.character(unique(out_selected$year))) %>%
+ purrr::map(~ .[selected_kin_position])
+ # long format
+ message(" Preparing output...")
+ kin <- lapply(names(kin_list), FUN = function(Y){
+ X <- kin_list[[Y]]
+ X <- purrr::map2(X, names(X), function(x,y){
+ # reassign deaths to Focal experienced age
+ x[(agess+1):(agess*2),1:(ages-1)] <- x[(agess+1):(agess*2),2:ages]
+ x[(agess+1):(agess*2),ages] <- 0
+ x <- data.table::as.data.table(x)
+ x$year <- Y
+ x$kin <- y
+ x$sex_kin <- rep(c(rep("f",ages), rep("m",ages)),2)
+ x$age_kin <- rep(age, 4)
+ x$alive <- c(rep("living",agess), rep("dead",agess))
+ return(x)
+ }) %>%
+ data.table::rbindlist() %>%
+ stats::setNames(c(as.character(age), "year","kin","sex_kin","age_kin","alive")) %>%
+ data.table::melt(id.vars = c("year","kin","sex_kin","age_kin","alive"), variable.name = "age_focal", value.name = "count")
+ X$age_focal = as.integer(as.character(X$age_focal))
+ X$year = as.integer(X$year)
+ X$cohort = X$year - X$age_focal
+ X <- X[X$age_focal %in% out_selected$age[out_selected$year==as.integer(Y)],]
+ X <- data.table::dcast(X, year + kin + sex_kin + age_kin + age_focal + cohort ~ alive, value.var = "count", fun.aggregate = sum)
+ }) %>% data.table::rbindlist()
+
+ # results as list?
+ if(list_output) {
+ out <- kin_list
+ }else{
+ out <- kin
+ }
+ return(out)
+}
+
+#' one time projection kin
+
+#' @description one time projection kin. internal function.
+#'
+#' @param Ut numeric. A matrix of survival probabilities (or ratios).
+#' @param Ft numeric. A matrix of age-specific fertility rates.
+#' @param Ft_star numeric. Ft but for female fertility.
+#' @param pit numeric. A matrix with distribution of childbearing.
+#' @param sex_focal character. "f" for female or "m" for male.
+#' @param ages numeric.
+#' @param pkin numeric. A list with kin count distribution in previous year.
+#' @return A list of 14 types of kin matrices (kin age by Focal age, blocked for two sex) projected one time interval.
+#' @export
+timevarying_kin_2sex<- function(Ut, Ft, Ft_star, pit, sex_focal, ages, pkin){
+
+ agess <- ages*2
+ om <- ages-1
+ pif <- pit[1:ages]
+ pim <- pit[(ages+1):agess]
+ phi = d = gd = ggd = m = gm = ggm = os = ys = nos = nys = oa = ya = coa = cya = matrix(0,agess*2,ages)
+ kin_list <- list(d=d,gd=gd,ggd=ggd,m=m,gm=gm,ggm=ggm,os=os,ys=ys,
+ nos=nos,nys=nys,oa=oa,ya=ya,coa=coa,cya=cya)
+
+ # G matrix moves focal by age
+ G <- matrix(0, nrow=ages, ncol=ages)
+ G[row(G)-1 == col(G)] <- 1
+ Gt <- matrix(0, agess*2, agess*2)
+ Gt[1:(agess), 1:(agess)] <- as.matrix(Matrix::bdiag(G, G))
+
+ # locate focal at age 0 depending sex
+ sex_index <- ifelse(sex_focal == "f", 1, ages+1)
+ phi[sex_index, 1] <- 1
+
+ # initial distribution
+ m[1:agess,1] = pit
+ gm[1:agess,1] = pkin[["m"]][1:agess,] %*% (pif + pim)
+ ggm[1:agess,1] = pkin[["gm"]][1:agess,] %*% (pif + pim)
+ oa[1:agess,1] = pkin[["os"]][1:agess,] %*% (pif + pim)
+ ya[1:agess,1] = pkin[["ys"]][1:agess,] %*% (pif + pim)
+ coa[1:agess,1] = pkin[["nos"]][1:agess,] %*% (pif + pim)
+ cya[1:agess,1] = pkin[["nys"]][1:agess,] %*% (pif + pim)
+ # atribuible to focal sex
+ pios = if(sex_focal == "f") pif else pim
+ os[1:agess,1] = pkin[["d"]][1:agess,] %*% pios
+ nos[1:agess,1] = pkin[["gd"]][1:ages,] %*% pios
+
+ for (ix in 1:om){
+ phi[,ix+1] = Gt %*% phi[, ix]
+ d[,ix+1] = Ut %*% pkin[["d"]][,ix] + Ft %*% phi[,ix]
+ gd[,ix+1] = Ut %*% pkin[["gd"]][,ix] + Ft %*% pkin[["d"]][,ix]
+ ggd[,ix+1] = Ut %*% pkin[["ggd"]][,ix] + Ft %*% pkin[["gd"]][,ix]
+ m[,ix+1] = Ut %*% pkin[["m"]][,ix]
+ gm[,ix+1] = Ut %*% pkin[["gm"]][,ix]
+ ggm[,ix+1] = Ut %*% pkin[["ggm"]][,ix]
+ os[,ix+1] = Ut %*% pkin[["os"]][,ix]
+ ys[,ix+1] = Ut %*% pkin[["ys"]][,ix] + Ft_star %*% pkin[["m"]][,ix]
+ nos[,ix+1] = Ut %*% pkin[["nos"]][,ix] + Ft %*% pkin[["os"]][,ix]
+ nys[,ix+1] = Ut %*% pkin[["nys"]][,ix] + Ft %*% pkin[["ys"]][,ix]
+ oa[,ix+1] = Ut %*% pkin[["oa"]][,ix]
+ ya[,ix+1] = Ut %*% pkin[["ya"]][,ix] + Ft_star %*% pkin[["gm"]][,ix]
+ coa[,ix+1] = Ut %*% pkin[["coa"]][,ix] + Ft %*% pkin[["oa"]][,ix]
+ cya[,ix+1] = Ut %*% pkin[["cya"]][,ix] + Ft %*% pkin[["ya"]][,ix]
+ }
+
+ kin_list <- list(d=d,gd=gd,ggd=ggd,m=m,gm=gm,ggm=ggm,os=os,ys=ys,
+ nos=nos,nys=nys,oa=oa,ya=ya,coa=coa,cya=cya)
+
+ return(kin_list)
+}
diff --git a/R/kin_time_variant_2sex_cod.R b/R/kin_time_variant_2sex_cod.R
new file mode 100644
index 0000000..b9f90ae
--- /dev/null
+++ b/R/kin_time_variant_2sex_cod.R
@@ -0,0 +1,320 @@
+#' Estimate kin counts in a time variant framework (dynamic rates) in a two-sex framework (Caswell, 2022)
+
+#' @description Two-sex matrix framework for kin count estimates with varying rates.
+#' This produces kin counts grouped by kin, age and sex of each relatives at each Focal´s age.
+#' For example, male cousins from aunts and uncles from different sibling's parents are grouped in one male count of cousins. This also produces kin deaths grouped by kin, age, sex of
+#' each relatives at each Focal´s age, and cause of death.
+#' @details See Caswell (2022) for details on formulas.
+#' @param pf numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).
+#' @param pm numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).
+#' @param ff numeric. Same as pf but for fertility rates.
+#' @param fm numeric. Same as pm but for fertility rates.
+#' @param Hf numeric. A list where each list element (being the name of each list element the year) contains a matrix with cause-specific hazards for females with rows as causes and columns as ages, being the name of each col the age.
+#' @param Hm numeric. A list where each list element (being the name of each list element the year) contains a matrix with cause-specific hazards for males with rows as causes and columns as ages, being the name of each col the age.
+#' @param sex_focal character. "f" for female or "m" for male.
+#' @param pif numeric. For using some specific age distribution of childbearing for mothers (same length as ages). Default `NULL`.
+#' @param pim numeric. For using some specific age distribution of childbearing for fathers (same length as ages). Default `NULL`.
+#' @param nf numeric. Same as pf but for population distribution (counts or `%`). Optional.
+#' @param nm numeric. Same as pm but for population distribution (counts or `%`). Optional.
+#' @param output_cohort integer. Vector of year cohorts for returning results. Should be within input data years range.
+#' @param output_period integer. Vector of period years for returning results. Should be within input data years range.
+#' @param output_kin character. kin types to return: "m" for mother, "d" for daughter,...
+#' @param birth_female numeric. Female portion at birth. This multiplies `f` argument. If `f` is already for female offspring, this needs to be set as 1.
+#' @param list_output logical. Results as a list with years elements (as a result of `output_cohort` and `output_period` combination), with a second list of `output_kin` elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default `FALSE`
+#' @return A data.frame with year, cohort, Focal´s age, related ages, sex and type of kin (for example `d` is daughter, `oa` is older aunts, etc.), including living and dead kin at that age and sex.
+#' @export
+
+# BEN: Added hazard matrices as inputs.
+# Assume that input of cause-specific mortality will be in terms of
+# matrices of cause-specific hazards for the two sexes (causes * ages).
+# Alternative: a matrix (causes * ages) containing the ratio mxi/mx.
+kin_time_variant_2sex_cod <- function(pf = NULL, pm = NULL,
+ ff = NULL, fm = NULL,
+ Hf = NULL, Hm = NULL,
+ sex_focal = "f",
+ birth_female = 1/2.04,
+ pif = NULL, pim = NULL,
+ nf = NULL, nm = NULL,
+ output_cohort = NULL, output_period = NULL, output_kin = NULL,
+ list_output = FALSE){
+
+ # global vars
+ .<-living<-dead<-age_kin<-age_focal<-cohort<-year<-total<-mean_age<-count_living<-sd_age<-count_dead<-mean_age_lost<-indicator<-value<-NULL
+
+ # same input length
+
+ # BEN: Now we should also check the dimensions of the cause-specific hazard
+ # matrices.
+ if(!all(dim(pf) == dim(pm), dim(pf) == dim(ff), dim(pf) == dim(fm),
+ nrow(Hf)==nrow(Hm), ncol(Hf)==ncol(Hm), ncol(Hf)==nrow(pf),
+ length(Hf)==length(Hm), length(Hm)==ncol(pf))) stop("Dimension of P's, F's, and H's should match")
+
+ # data should be from same interval years
+ years_data <- as.integer(colnames(pf))
+ if(stats::var(diff(years_data))!=0) stop("Data should be for same interval length years. Fill the gaps and run again")
+
+ # utils
+ age <- 0:(nrow(pf)-1)
+ n_years_data <- length(years_data)
+ ages <- length(age)
+ agess <- ages*2
+ om <- max(age)
+
+ # BEN: The zero matrix was deleted from line above and has
+ # to be made specific according to living/dead kin
+ # part of the block matrix Ut.
+ causes <- nrow(Hf[[1]]) # number of causes of death
+ zeros_l <- matrix(0, nrow = ages, ncol = (causes*ages)) # zero matrix for living kin part
+ zeros_d = matrix(0, nrow = (causes*ages), ncol = (causes*ages)) # zero matrix for death kin part
+
+ # age distribution at child born
+ Pif <- pif; no_Pif <- FALSE
+ Pim <- pim; no_Pim <- FALSE
+ if(is.null(pif)){
+ if(!is.null(nf)){
+ Pif <- t(t(nf * ff)/colSums(nf * ff))
+ }else{
+ Pif <- matrix(0, nrow=ages, ncol=n_years_data)
+ no_Pif <- TRUE
+ }
+ }
+ if(is.null(pim)){
+ if(!is.null(nm)){
+ Pim <- t(t(nm * fm)/colSums(nm * fm))
+ }else{
+ Pim <- matrix(0, nrow=ages, ncol=n_years_data)
+ no_Pim <- TRUE
+ }
+ }
+
+ # get lists of matrix
+ Ul = Fl = Fl_star = list()
+ kin_all <- list()
+ pb <- progress::progress_bar$new(
+ format = "Running over input years [:bar] :percent",
+ total = n_years_data + 1, clear = FALSE, width = 60)
+
+ # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ # BEN: First load function at the end of script
+ # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ for(t in 1:n_years_data){
+ # t = 1
+ Uf = Um = Fft = Fmt = Mm = Mf = Gt = matrix(0, nrow=ages, ncol=ages)
+ Uf[row(Uf)-1 == col(Uf)] <- pf[-ages,t]
+ Uf[ages, ages] = pf[ages,t]
+ Um[row(Um)-1 == col(Um)] <- pm[-ages,t]
+ Um[ages, ages] = pm[ages,t]
+
+ # BEN: Building of M, matrix of cause-specific prob. of dying.
+ # Hence, M = H D(h_tilde)^{-1} D(q)
+ # where h_tilde are the summed hazards for each age, and
+ # q = 1 - p
+ sum_hf <- t(rep(1, causes)) %*% Hf[[t]] # h_tilde female
+ sum_hm <- t(rep(1, causes)) %*% Hm[[t]] # h_tilde male
+ Mf <- Hf[[t]] %*% solve(diag(c(sum_hf))) %*% diag(1-pf[,t])
+ Mm <- Hm[[t]] %*% solve(diag(c(sum_hm))) %*% diag(1-pm[,t])
+ # Mm <- diag(1-pm[,t])
+ # Mf <- diag(1-pf[,t])
+
+ # BEN: In order to classify kin death by both cause and age at death,
+ # we need a mortality matrices M_hat of dimension
+ # ((causes*ages) * ages). See eq.12 in Caswell et al. (2024).
+ # Store columns of M as a list of vectors
+ Mf.cols <- lapply(1:ncol(Mf), function(j) return(Mf[,j]))
+ Mm.cols <- lapply(1:ncol(Mm), function(j) return(Mm[,j]))
+ # Create M_hat using the vectors as elements of the block diagonal
+ Ut <- as.matrix(rbind(
+ cbind(Matrix::bdiag(Uf, Um), Matrix::bdiag(zeros_l, zeros_l)),
+ cbind(Matrix::bdiag(Matrix::bdiag(Mf.cols), Matrix::bdiag(Mm.cols)), Matrix::bdiag(zeros_d, zeros_d))))
+
+ Ul[[as.character(years_data[t])]] <- Ut
+ Fft[1,] = ff[,t]
+ Fmt[1,] = fm[,t]
+
+ # BEN: Accounting for causes of death leads to have different dimensions
+ # in Ft and Ft_star.
+ Ft <- Ft_star <- matrix(0, (agess + agess*causes), (agess + agess*causes))
+
+ Ft[1:agess,1:agess] <- rbind(cbind(birth_female * Fft, birth_female * Fmt),
+ cbind((1-birth_female) * Fft, (1-birth_female) * Fmt))
+ Ft_star[1:agess,1:ages] <- rbind(birth_female * Fft, (1-birth_female) * Fft)
+ Fl[[as.character(years_data[t])]] <- Ft
+ Fl_star[[as.character(years_data[t])]] <- Ft_star
+ A = Matrix::bdiag(Uf, Um) + Ft_star[1:agess,1:agess]
+
+ # stable assumption at start
+ if (t==1){
+ p1f <- pf[,1]; p1m <- pm[,1]
+ f1f <- ff[,1]; f1m <- fm[,1]
+ # time boundary for pi
+ A_decomp = eigen(A)
+ lambda = as.double(A_decomp$values[1])
+ w = as.double(A_decomp$vectors[,1])/sum(as.double(A_decomp$vectors[,1]))
+ wf = w[1:ages]
+ wm = w[(ages+1):(2*ages)]
+ pif1 = wf * ff[,t] / sum(wf * ff[,t])
+ pim1 = wm * fm[,t] / sum(wm * fm[,t])
+
+ # BEN: Add Hf and Hm
+ H1f <- Hf[[1]]
+ H1m <- Hm[[1]]
+
+ # BEN: cod version !!!
+ kin_all[[1]] <- kin_time_invariant_2sex_cod(pf = p1f, pm = p1m,
+ ff = f1f, fm = f1m,
+ pif = pif1, pim = pim1,
+ Hf = H1f, Hm = H1m,
+ birth_female = birth_female, list_output = TRUE)
+ }
+
+ # project pi
+ if(no_Pim | no_Pif){
+ w <- A %*% w
+ wf <- w[1:ages]
+ wm <- w[(ages+1):(2*ages)]
+ Pif[,t] <- wf * ff[,t] / sum(wf * ff[,t])
+ Pim[,t] <- wm * fm[,t] / sum(wm * fm[,t])
+ }
+ pit <- c(Pif[,t], Pim[,t])
+
+ # kin for next year
+ kin_all[[t+1]] <- timevarying_kin_2sex_cod(Ut=Ut, Ft=Ft, Ft_star=Ft_star, causes,
+ pit=pit, sex_focal, ages, pkin=kin_all[[t]])
+ pb$tick()
+ }
+
+ # filter years and kin that were selected
+ names(kin_all) <- as.character(years_data)
+
+ # combinations to return
+ out_selected <- output_period_cohort_combination(output_cohort, output_period, age = age, years_data = years_data)
+
+ possible_kin <- c("d","gd","ggd","m","gm","ggm","os","ys","nos","nys","oa","ya","coa","cya")
+ if(is.null(output_kin)){
+ selected_kin_position <- 1:length(possible_kin)
+ }else{
+ selected_kin_position <- which(possible_kin %in% output_kin)
+ }
+
+ # first filter
+ kin_list <- kin_all %>%
+ purrr::keep(names(.) %in% as.character(unique(out_selected$year))) %>%
+ purrr::map(~ .[selected_kin_position])
+ # long format
+ message("Preparing output...")
+ kin <- lapply(names(kin_list), FUN = function(Y){
+ X <- kin_list[[Y]]
+ X <- purrr::map2(X, names(X), function(x,y){
+ # reassign deaths to Focal experienced age
+ x[(agess+1):(agess + agess*causes),1:(ages-1)] <- x[(agess+1):(agess + agess*causes),2:ages]
+ x[(agess+1):(agess + agess*causes),ages] <- 0
+ x <- data.table::as.data.table(x)
+ x$year <- Y
+ x$kin <- y
+ x$sex_kin <- c(rep(c("f", "m"),each=ages), rep(c("f", "m"),each=ages*causes))
+ x$age_kin <- c(rep(age,2), rep(rep(age,each=causes),2))
+ x$alive <- c(rep("living",2*ages), rep(paste0("deadcause",1:causes),2*ages))
+ return(x)
+ }) %>%
+ data.table::rbindlist() %>%
+ stats::setNames(c(as.character(age), "year","kin","sex_kin","age_kin","alive")) %>%
+ data.table::melt(id.vars = c("year","kin","sex_kin","age_kin","alive"), variable.name = "age_focal", value.name = "count")
+ X$age_focal = as.integer(as.character(X$age_focal))
+ X$year = as.integer(X$year)
+ X$cohort = X$year - X$age_focal
+ X <- X[X$age_focal %in% out_selected$age[out_selected$year==as.integer(Y)],]
+ X <- data.table::dcast(X, year + kin + sex_kin + age_kin + age_focal + cohort ~ alive, value.var = "count", fun.aggregate = sum)
+ }) %>% data.table::rbindlist()
+
+ # results as list?
+ if(list_output) {
+ out <- kin_list
+ }else{
+ out <- kin
+ }
+ return(out)
+}
+
+#' one time projection kin
+
+#' @description one time projection kin. internal function.
+#'
+#' @param Ut numeric. A matrix of survival probabilities (or ratios).
+#' @param Ft numeric. A matrix of age-specific fertility rates.
+#' @param Ft_star numeric. Ft but for female fertility.
+#' @param causes integer. Number of causes of death included.
+#' @param pit numeric. A matrix with distribution of childbearing.
+#' @param sex_focal character. "f" for female or "m" for male.
+#' @param ages numeric.
+#' @param pkin numeric. A list with kin count distribution in previous year.
+#' @return A list of 14 types of kin matrices (kin age by Focal age, blocked for two sex) projected one time interval.
+#' @export
+timevarying_kin_2sex_cod<- function(Ut, Ft, Ft_star, causes, pit, sex_focal, ages, pkin){
+
+ agess <- ages*2
+ om <- ages-1
+ pif <- pit[1:ages]
+ pim <- pit[(ages+1):agess]
+
+ # BEN : Add the number of CoD - IW: already as argument (Hf is not an argument)
+ # causes <- nrow(Hf[[1]])
+
+ # BEN: Changed dimensions of lower part (dead kin) to account for death from causes.
+ phi = d = gd = ggd = m = gm = ggm = os = ys = nos = nys = oa = ya = coa = cya = matrix(0, (agess + agess*causes), ages)
+
+ kin_list <- list(d=d,gd=gd,ggd=ggd,m=m,gm=gm,ggm=ggm,os=os,ys=ys,
+ nos=nos,nys=nys,oa=oa,ya=ya,coa=coa,cya=cya)
+
+ # G matrix moves focal by age
+ G <- matrix(0, nrow=ages, ncol=ages)
+ G[row(G)-1 == col(G)] <- 1
+
+ # BEN: Changed dimensions
+ Gt <- matrix(0, (agess + agess*causes), (agess + agess*causes))
+
+ Gt[1:(agess), 1:(agess)] <- as.matrix(Matrix::bdiag(G, G))
+
+ # locate focal at age 0 depending sex
+ sex_index <- ifelse(sex_focal == "f", 1, ages+1)
+ phi[sex_index, 1] <- 1
+
+ # BEN: NOT SURE ABOUT WHAT IS HAPPENING BELOW
+ # Rows are multiplied by the sum of the pi?
+
+ # initial distribution
+ m[1:agess,1] = pit
+ gm[1:agess,1] = pkin[["m"]][1:agess,] %*% (pif + pim)
+ ggm[1:agess,1] = pkin[["gm"]][1:agess,] %*% (pif + pim)
+ oa[1:agess,1] = pkin[["os"]][1:agess,] %*% (pif + pim)
+ ya[1:agess,1] = pkin[["ys"]][1:agess,] %*% (pif + pim)
+ coa[1:agess,1] = pkin[["nos"]][1:agess,] %*% (pif + pim)
+ cya[1:agess,1] = pkin[["nys"]][1:agess,] %*% (pif + pim)
+ # atribuible to focal sex
+ pios <- if(sex_focal == "f") pif else pim
+ os[1:agess,1] = pkin[["d"]][1:agess,] %*% pios
+ nos[1:agess,1] = pkin[["gd"]][1:ages,] %*% pios
+
+ for (ix in 1:om){
+ phi[,ix+1] = Gt %*% phi[, ix]
+ d[,ix+1] = Ut %*% pkin[["d"]][,ix] + Ft %*% phi[,ix]
+ gd[,ix+1] = Ut %*% pkin[["gd"]][,ix] + Ft %*% pkin[["d"]][,ix]
+ ggd[,ix+1] = Ut %*% pkin[["ggd"]][,ix] + Ft %*% pkin[["gd"]][,ix]
+ m[,ix+1] = Ut %*% pkin[["m"]][,ix]
+ gm[,ix+1] = Ut %*% pkin[["gm"]][,ix]
+ ggm[,ix+1] = Ut %*% pkin[["ggm"]][,ix]
+ os[,ix+1] = Ut %*% pkin[["os"]][,ix]
+ ys[,ix+1] = Ut %*% pkin[["ys"]][,ix] + Ft_star %*% pkin[["m"]][,ix]
+ nos[,ix+1] = Ut %*% pkin[["nos"]][,ix] + Ft %*% pkin[["os"]][,ix]
+ nys[,ix+1] = Ut %*% pkin[["nys"]][,ix] + Ft %*% pkin[["ys"]][,ix]
+ oa[,ix+1] = Ut %*% pkin[["oa"]][,ix]
+ ya[,ix+1] = Ut %*% pkin[["ya"]][,ix] + Ft_star %*% pkin[["gm"]][,ix]
+ coa[,ix+1] = Ut %*% pkin[["coa"]][,ix] + Ft %*% pkin[["oa"]][,ix]
+ cya[,ix+1] = Ut %*% pkin[["cya"]][,ix] + Ft %*% pkin[["ya"]][,ix]
+ }
+
+ kin_list <- list(d=d,gd=gd,ggd=ggd,m=m,gm=gm,ggm=ggm,os=os,ys=ys,
+ nos=nos,nys=nys,oa=oa,ya=ya,coa=coa,cya=cya)
+
+ return(kin_list)
+}
diff --git a/R/plot_diagramm.R b/R/plot_diagramm.R
index 2497186..6bffa8c 100644
--- a/R/plot_diagramm.R
+++ b/R/plot_diagramm.R
@@ -1,90 +1,77 @@
#' plot a Kin diagram (network)
-#' @description Given estimation of kin counts from `kins` function, draw a network diagramm.
-#' @param kin_total data.frame. With columns `kin` with type and `count` with some measeure.
-#' @param rounding numeric. Estimation could have a lot of decimals. Rounding will make looks more clear the diagramm.
-#' @return A plot
+#' @description Draws a Keyfitz-style kinship diagram given a kinship object created by the `kin` function. Displays expected kin counts for a Focal aged 'a'.
+#' @param kin_total data.frame. values in column `kin` define the relative type - see `demokin_codes()`. Values in column `count` are the expected number of relatives.
+#' @param rounding numeric. Number of decimals to show in diagram.
+#' @return A Keyfitz-style kinship plot.
#' @export
-plot_diagram <- function(kin_total, rounding = 3){
-
- vertices <- data.frame(
- nodes = c("ggd", "gd", "d", "Focal", "m", "gm", "ggm", "oa", "coa", "os", "nos", "ya", "cya", "ys", "nys")
- , x = c(1, 1, 1, 1, 1, 1, 1, 0, -1, 0, -1, 2, 3, 2, 3)
- , y = c(0, 1, 2, 3, 4, 5, 6, 4, 3, 3, 2, 4, 3, 3, 2)
- )
-
- d <- data.frame(
- from = c("ggd", "gd", "d", "Focal", "m", "gm", "gm", "oa", "m", "os", "gm", "ya", "m", "ys")
- , to = c("gd", "d", "Focal", "m", "gm", "ggm", "oa", "coa", "os", "nos", "ya", "cya", "ys", "nys")
- )
-
- # Add values
- lookup <- c(with(kin_total, paste0(kin, " \n", round(count, rounding))), "Focal")
- names(lookup) <- c(kin_total$kin, "Focal")
-
- vertices$nodes <- lookup[vertices$nodes]
- d$from <- lookup[d$from]
- d$to <- lookup[d$to]
-
- # Plot
-
- b <- igraph::graph_from_data_frame(vertices = vertices, d= d, directed = FALSE)
-
- plot(
- b
- , vertex.size = 30
- , curved = 1
- , vertex.color = "#FFF1E2"
- , vertex.shape = "circle"
- , vertex.label.cex = 0.8
- , vertex.label.color = "black"
- , label.degree = -pi/2
- , edge.width = 2
- , edge.color = "black"
- )
-
-}
-
-# old function
-
-# plot_diagram <- function(kin_total, rounding = 3){
-# # https://cran.r-project.org/web/packages/DiagrammeR/vignettes/graphviz-mermaid.html
-# # https://color.hailpixel.com/#D9E9BE,BF62CB,94C2DB,79D297,CDA76A,C8695B
-#
-# kin_total <- kin_total %>% mutate(count = round(count,digits = rounding))
-#
-# DiagrammeR::mermaid(
-# paste0("graph TD
-#
-# GGM(ggm: ", kin_total$count[kin_total$kin=="ggm"] ,")
-# GGM ==> GM(gm: ", kin_total$count[kin_total$kin=="gm"] ,")
-# GM --> AOM(oa: ", kin_total$count[kin_total$kin=="oa"] ,")
-# GM ==> M(m: ", kin_total$count[kin_total$kin=="m"] ,")
-# GM --> AYM(ya: ", kin_total$count[kin_total$kin=="ya"] ,")
-# AOM --> CAOM(coa: ", kin_total$count[kin_total$kin=="coa"] ,")
-# M --> OS(os: ", kin_total$count[kin_total$kin=="os"] ,")
-# M ==> E((Ego))
-# M --> YS(ys: ", kin_total$count[kin_total$kin=="ys"] ,")
-# AYM --> CAYM(cya: ", kin_total$count[kin_total$kin=="cya"] ,")
-# OS --> NOS(nos: ", kin_total$count[kin_total$kin=="nos"] ,")
-# E ==> D(d: ", kin_total$count[kin_total$kin=="d"] ,")
-# YS --> NYS(nys: ", kin_total$count[kin_total$kin=="nys"] ,")
-# D ==> GD(gd: ", kin_total$count[kin_total$kin=="gd"] ,")
-# style GGM fill:#a1f590, stroke:#333, stroke-width:2px;
-# style GM fill:#a1f590, stroke:#333, stroke-width:2px, text-align: center;
-# style M fill:#a1f590, stroke:#333, stroke-width:2px, text-align: center
-# style D fill:#a1f590, stroke:#333, stroke-width:2px, text-align: center
-# style YS fill:#a1f590, stroke:#333, stroke-width:2px, text-align: center
-# style OS fill:#a1f590, stroke:#333, stroke-width:2px, text-align: center
-# style CAOM fill:#f1f0f5, stroke:#333, stroke-width:2px, text-align: center
-# style AYM fill:#f1f0f5, stroke:#333, stroke-width:2px, text-align: center
-# style AOM fill:#f1f0f5, stroke:#333, stroke-width:2px, text-align: center
-# style CAYM fill:#f1f0f5, stroke:#333, stroke-width:2px, text-align: center
-# style NOS fill:#f1f0f5, stroke:#333, stroke-width:2px, text-align: center
-# style NYS fill:#f1f0f5, stroke:#333, stroke-width:2px, text-align: center
-# style E fill:#FFF, stroke:#333, stroke-width:4px, text-align: center
-# style D fill:#a1f590, stroke:#333, stroke-width:2px, text-align: center
-# style GD fill:#a1f590, stroke:#333, stroke-width:2px, text-align: center"))
-# }
-
+plot_diagram <-
+ function (kin_total, rounding = 3) {
+ rels <- c("ggd", "gd", "d", "Focal", "m", "gm", "ggm", "oa", "coa", "os", "nos", "ya", "cya", "ys", "nys")
+ # check all types are in
+ if(!any(unique(kin_total$kin) %in% rels) | any(c("s", "c", "a", "n") %in% unique(kin_total$kin))) stop("You need all specific types. If some are missed or grouped, for example old and younger sisters in 's', this will fail.")
+ vertices <- data.frame(
+ nodes = rels
+ , x = c(1, 1, 1, 1, 1, 1, 1, 0, -1, 0, -1, 2, 3, 2, 3)
+ , y = c(0, 1, 2, 3, 4, 5, 6, 4, 3, 3, 2, 4, 3, 3, 2)
+ )
+ d <- data.frame(from = c("ggd", "gd", "d", "Focal", "m",
+ "gm", "gm", "oa", "m", "os", "gm", "ya", "m", "ys"),
+ to = c("gd", "d", "Focal", "m", "gm", "ggm", "oa", "coa",
+ "os", "nos", "ya", "cya", "ys", "nys"))
+ lookup <- c(with(kin_total, paste0(kin, " \n", round(count, rounding))), "Focal")
+ names(lookup) <- c(kin_total$kin, "Focal")
+ vertices$nodes <- lookup[vertices$nodes]
+ d$from <- lookup[d$from]
+ d$to <- lookup[d$to]
+ # to show full relative names
+ relatives <- c("Cousins from older aunt", "Cousins from younger aunt",
+ "Daughter", "Grand-daughter", "Great-grand-daughter",
+ "Great-grandmother", "Grandmother", "Mother", "Nieces from older sister",
+ "Nieces from younger sister", "Aunt older than mother",
+ "Aunt younger than mother", "Older sister", "Younger sister", "")
+ names(relatives) <- c("coa", "cya", "d", "gd", "ggd",
+ "ggm", "gm", "m", "nos", "nys", "oa", "ya", "os",
+ "ys", "Focal")
+ labs <- relatives[rels]
+ # Plot
+ b <- igraph::graph_from_data_frame(vertices = vertices, d= d, directed = FALSE)
+ b_auto_layout <- igraph::layout.auto(b)
+ b_auto_layout_scaled <- igraph::norm_coords(b_auto_layout, ymin=-1, ymax=1, xmin=-1, xmax=1)
+ plot(
+ b
+ , vertex.size = 70
+ , curved = 1
+ , vertex.color = "#FFF1E2"
+ , vertex.shape = "circle"
+ , vertex.label.cex = 0.8
+ , vertex.label.color = "black"
+ , edge.width = 2
+ , layout = b_auto_layout_scaled * 3
+ , rescale = FALSE
+ , xlim = c(-3.3,3.3)
+ , ylim = c(-3.1,3.1)
+ )
+ # Add relative names
+ # Thanks to Egor Kotov for this tip!
+ plot(
+ b
+ , vertex.size = 70
+ , curved = 1
+ , vertex.color = NA
+ , vertex.shape = "none"
+ , vertex.label = labs
+ , vertex.label.dist = -6.5
+ , vertex.label.cex = 0.8
+ , vertex.label.color = "black"
+ , vertex.label.degree = -pi/2
+ , edge.width = 2
+ , edge.color = NA
+ , layout = b_auto_layout_scaled * 3
+ , rescale = FALSE
+ , xlim = c(-3.3,3.3)
+ , ylim = c(-3.1,3.1)
+ , add = T
+ )
+ }
diff --git a/README.Rmd b/README.Rmd
index 5eb0592..f0f0483 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -2,7 +2,7 @@
output: github_document
---
-
+
```{r, include = FALSE}
knitr::opts_chunk$set(
@@ -11,105 +11,122 @@ knitr::opts_chunk$set(
fig.path = "man/figures/README-",
out.width = "100%"
)
-devtools::load_all()
-library(DemoKin)
+pkgload::load_all()
library(knitr)
```
-
# DemoKin
-:::::::::::::: {.columns}
-::: {.column width="60%"}
+::: {.columns}
+::: {.column width="30%"}
-
-`DemoKin` uses matrix demographic methods to compute expected (average) kin counts from demographic rates under a range of scenarios and assumptions. The package is an R-language implementation of Caswell (2019), Caswell (2020), and Caswell and Song (2021). It draws on previous theoretical development by Goodman, Keyfitz and Pullum (1974).
+
:::
-::: {.column width="40%"}
+::: {.column width="70%"}
-
+This is an R package for the demographic analysis of kinship networks using matrix-based models.
+It implements methods developed initially by [Caswell (2019)](https://www.demographic-research.org/articles/volume/41/24), and continued in successive papers (like [Caswell (2020)](https://www.demographic-research.org/articles/volume/42/38) or [Caswell (2024)](https://www.demographic-research.org/articles/volume/49/41)) for estimating the number and age distribution of relatives under various demographic assumptions.
:::
-::::::::::::::
+:::
+
+## Features
+
+- Estimate kin counts and age distributions for various types of relatives
+- Support for one-sex and two-sex models
+- Time-invariant and time-varying approaches
+- Multi-state models incorporating additional variables like parity or education
+- Visualization tools for kinship networks
## Installation
-You can install the development version from GitHub with:
+You can install the development version of DemoKin from GitHub:
-``` {r, eval=FALSE}
-# install.packages("devtools")
-devtools::install_github("IvanWilli/DemoKin")
+```{r, eval = F}
+# install.packages("remotes")
+remotes::install_github("IvanWilli/DemoKin")
+library(DemoKin)
```
## Usage
-Consider an average Swedish woman called 'Focal'. For this exercise, we assume a female closed population in which everyone experiences the Swedish 2015 mortality and fertility rates at each age throughout their life (the 'time-invariant' assumption in Caswell [2019]).
+Here's a basic example of how to use DemoKin:
-We then ask:
+```{r, eval = T, warning=FALSE, message=F, dev="svg", fig.width=6, fig.height=4, out.width="70%"}
-> How many living relatives does Focal have at each age?
-
-Let's explore this using the Swedish data already included with `DemoKin`.
+# Run a one-sex time-invariant kinship model using Swedish data from 2015
+kin_results <- kin(
+ p = swe_px[,"2015"], # Survival probabilities
+ f = swe_asfr[,"2015"], # Fertility rates
+ time_invariant = TRUE # Use time-invariant model
+)
-```{r, fig.height=6, fig.width=8}
-library(DemoKin)
-swe_surv_2015 <- swe_px[,"2015"]
-swe_asfr_2015 <- swe_asfr[,"2015"]
-swe_2015 <- kin(U = swe_surv_2015, f = swe_asfr_2015, time_invariant = TRUE)
+# Visualize the expected number of living relatives by age
+kin_results$kin_summary %>%
+ rename_kin() %>%
+ ggplot2::ggplot(ggplot2::aes(age_focal, count_living)) +
+ ggplot2::geom_line() +
+ ggplot2::facet_wrap(~kin_label, scales = "free_y") +
+ ggplot2::labs(
+ title = "Expected number of living relatives by age",
+ x = "Age of focal individual",
+ y = "Number of relatives"
+ )
```
-*px* is the survival probability by age from a life table and *f* are the age specific fertility raties by age (see `?kin` for details).
+## Documentation
-Now, we can visualize the implied kin counts (i.e., the average number of living kin) of Focal at age 35 using a network or 'Keyfitz' kinship diagram with the function `plot_diagram`:
+For detailed documentation, please visit the [DemoKin website](https://ivanwilli.github.io/DemoKin/).
-```{r, fig.height=6, dpi=1200,fig.width=8, message=FALSE, warning=FALSE}
-# We need to reformat the data a little bit
-kin_total <- swe_2015$kin_summary
-# Keep only data for Focal's age 35
-kin_total <- kin_total[kin_total$age_focal == 35 , c("kin", "count_living")]
-names(kin_total) <- c("kin", "count")
-plot_diagram(kin_total, rounding = 2)
-```
+The site includes several vignettes demonstrating different types of kinship models:
-Relatives are identified by a unique code:
+### Models stratified by age
+- [One-sex time-invariant kinship model](https://ivanwilli.github.io/DemoKin/articles/1_1_OneSex_TimeInvariant_Age.html)
+- [One-sex time-varying kinship model](https://ivanwilli.github.io/DemoKin/articles/1_2_OneSex_TimeVarying_Age.html)
+- [Two-sex time-invariant kinship model](https://ivanwilli.github.io/DemoKin/articles/1_3_TwoSex_TimeInvariant_Age.html)
+- [Two-sex time-varying kinship model](https://ivanwilli.github.io/DemoKin/articles/1_4_TwoSex_TimeVarying_Age.html)
-```{r, fig.height=6, fig.width=8, echo=FALSE}
-kable(DemoKin::demokin_codes()[-2])
-```
+### Models stratified by age and stage
+- [One-sex time-invariant multi-state model](https://ivanwilli.github.io/DemoKin/articles/2_1_OneSex_TimeInvariant_AgeStage.html)
+- [Two-sex time-varying multi-state model](https://ivanwilli.github.io/DemoKin/articles/2_2_TwoSex_TimeVarying_AgeStage.html)
-## Vignette
+## Contributors
-For more details, including an extension to time varying-populations rates, deceased kin, and multi-state models, see `vignette("Reference", package = "DemoKin")`.
-If the vignette does not load, you may need to install the package as `devtools::install_github("IvanWilli/DemoKin", build_vignettes = T)`.
+`DemoKin` has benefited from the work of many people over the years, including:
-## Citation
+- **Ivan Williams** (University of Buenos Aires) leads the technical development of `DemoKin` with a particular focus on the implementation of the functions in R.
-Williams, Iván; Alburez-Gutierrez, Diego; Song, Xi; and Hal Caswell. (2021) DemoKin: An R package to implement demographic matrix kinship models. URL: https://github.com/IvanWilli/DemoKin.
+- **Diego Alburez-Gutierrez** (Max Planck Institute for Demographic Research) coordinates the development of the package.
-## Acknowledgments
+- **Hal Caswell** (University of Amsterdam) provided crucial MATLAB code for computing matrix kinship models.
- We thank Silvia Leek from the Max Planck Institute for Demographic Research for designing the DemoKin logo. The logo includes elements that have been taken or adapted [from this file](https://commons.wikimedia.org/wiki/File:Escudo_de_la_Orden_de_San_Jer%C3%B3nimo.svg), originally by Ansunando, [CC BY-SA 4.0](https://creativecommons.org/licenses/by-sa/4.0) via Wikimedia Commons. Sha Jiang provided useful comments for improving the package.
+- **Xi Song** (University of Pennsylvania) contributed the code to estimate time variant kinship models.
-## Get involved!
-
-`DemoKin` is under constant development.
-If you're interested in contributing, please get in touch, create an issue, or submit a pull request.
-We look forward to hearing from you!
+- **Benjamin Schlüter** (University of Toronto) contributed code to implement bereavement analysis by cause of death.
-## References
+- **Joe Butterick** (University of Southampton) contributed code to implement time-variant, two-sex multistate kinship models.
-Caswell, H. 2019. The formal demography of kinship: A matrix formulation. Demographic Research 41:679–712. doi:10.4054/DemRes.2019.41.24.
+- **Jason Hilton** (University of Southampton) contributed code to implement time-variant, two-sex multistate kinship models.
-Caswell, H. 2020. The formal demography of kinship II: Multistate models, parity, and sibship. Demographic Research 42: 1097-1144. doi:10.4054/DemRes.2020.42.38.
+- **Sha Jiang** (Max Planck Institute for Demographic Research) helped create and organise the documention for the package, including developing the package’s website.
-Caswell, Hal and Xi Song. 2021. “The Formal Demography of Kinship. III. Kinship Dynamics with Time-Varying Demographic Rates.” Demographic Research 45: 517–46. doi:10.4054/DemRes.2021.45.16.
+- **Amanda Martins** (Max Planck Institute for Demographic Research) developed materials for teaching DemoKin, including a course at the [European Doctoral School of Demography]( https://amandamartinsal.github.io/EDSD_kinship_24-25/).
-Goodman, L.A., Keyfitz, N., and Pullum, T.W. (1974). Family formation and the frequency of various kinship relationships. Theoretical Population Biology 5(1):1–27. doi:10.1016/0040-5809(74)90049-5.
+## Citation
-
+Williams, Iván; Alburez-Gutierrez, Diego; and the DemoKin team. (2021) DemoKin: An R package to implement demographic matrix kinship models. URL: https://github.com/IvanWilli/DemoKin.
-
-
+## Acknowledgments
+
+We thank Silvia Leek from the Max Planck Institute for Demographic Research for designing the DemoKin logo. The logo includes elements that have been taken or adapted [from this file](https://commons.wikimedia.org/wiki/File:Escudo_de_la_Orden_de_San_Jer%C3%B3nimo.svg), originally by Ansunando, [CC BY-SA 4.0](https://creativecommons.org/licenses/by-sa/4.0) via Wikimedia Commons. Sha Jiang provided useful comments for improving the package.
+
+## Get involved!
+
+`DemoKin` is under constant development.
+If you're interested in contributing, please get in touch, create an [issue](https://github.com/IvanWilli/DemoKin/issues), or submit a pull request.
+We look forward to hearing from you!
+## License
+This project is licensed under the MIT License - see the LICENSE file for details.
diff --git a/README.md b/README.md
index 0142d8b..b88b6eb 100644
--- a/README.md
+++ b/README.md
@@ -1,108 +1,148 @@
-
+
# DemoKin
-
+
-`DemoKin` uses matrix demographic methods to compute expected (average)
-kin counts from demographic rates under a range of scenarios and
-assumptions. The package is an R-language implementation of Caswell
-(2019), Caswell (2020), and Caswell and Song (2021). It draws on
-previous theoretical development by Goodman, Keyfitz and Pullum (1974).
+
-
+
-
+This is an R package for the demographic analysis of kinship networks
+using matrix-based models.
+It implements methods developed initially by [Caswell
+(2019)](https://www.demographic-research.org/articles/volume/41/24), and
+continued in successive papers (like [Caswell
+(2020)](https://www.demographic-research.org/articles/volume/42/38) or
+[Caswell
+(2024)](https://www.demographic-research.org/articles/volume/49/41)) for
+estimating the number and age distribution of relatives under various
+demographic assumptions.
+## Features
+
+- Estimate kin counts and age distributions for various types of
+ relatives
+- Support for one-sex and two-sex models
+- Time-invariant and time-varying approaches
+- Multi-state models incorporating additional variables like parity or
+ education
+- Visualization tools for kinship networks
+
## Installation
-You can install the development version from GitHub with:
+You can install the development version of DemoKin from GitHub:
``` r
-# install.packages("devtools")
-devtools::install_github("IvanWilli/DemoKin")
+# install.packages("remotes")
+remotes::install_github("IvanWilli/DemoKin")
+library(DemoKin)
```
## Usage
-Consider an average Swedish woman called ‘Focal’. For this exercise, we
-assume a female closed population in which everyone experiences the
-Swedish 2015 mortality and fertility rates at each age throughout their
-life (the ‘time-invariant’ assumption in Caswell \[2019\]).
+Here’s a basic example of how to use DemoKin:
-We then ask:
+``` r
-> How many living relatives does Focal have at each age?
+# Run a one-sex time-invariant kinship model using Swedish data from 2015
+kin_results <- kin(
+ p = swe_px[,"2015"], # Survival probabilities
+ f = swe_asfr[,"2015"], # Fertility rates
+ time_invariant = TRUE # Use time-invariant model
+)
+
+# Visualize the expected number of living relatives by age
+kin_results$kin_summary %>%
+ rename_kin() %>%
+ ggplot2::ggplot(ggplot2::aes(age_focal, count_living)) +
+ ggplot2::geom_line() +
+ ggplot2::facet_wrap(~kin_label, scales = "free_y") +
+ ggplot2::labs(
+ title = "Expected number of living relatives by age",
+ x = "Age of focal individual",
+ y = "Number of relatives"
+ )
+```
-Let’s explore this using the Swedish data already included with
-`DemoKin`.
+
-``` r
-library(DemoKin)
-swe_surv_2015 <- swe_px[,"2015"]
-swe_asfr_2015 <- swe_asfr[,"2015"]
-swe_2015 <- kin(U = swe_surv_2015, f = swe_asfr_2015, time_invariant = TRUE)
-```
+## Documentation
-*px* is the survival probability by age from a life table and *f* are
-the age specific fertility raties by age (see `?kin` for details).
+For detailed documentation, please visit the [DemoKin
+website](https://ivanwilli.github.io/DemoKin/).
-Now, we can visualize the implied kin counts (i.e., the average number
-of living kin) of Focal at age 35 using a network or ‘Keyfitz’ kinship
-diagram with the function `plot_diagram`:
+The site includes several vignettes demonstrating different types of
+kinship models:
-``` r
-# We need to reformat the data a little bit
-kin_total <- swe_2015$kin_summary
-# Keep only data for Focal's age 35
-kin_total <- kin_total[kin_total$age_focal == 35 , c("kin", "count_living")]
-names(kin_total) <- c("kin", "count")
-plot_diagram(kin_total, rounding = 2)
-```
+### Models stratified by age
+
+- [One-sex time-invariant kinship
+ model](https://ivanwilli.github.io/DemoKin/articles/1_1_OneSex_TimeInvariant_Age.html)
+- [One-sex time-varying kinship
+ model](https://ivanwilli.github.io/DemoKin/articles/1_2_OneSex_TimeVarying_Age.html)
+- [Two-sex time-invariant kinship
+ model](https://ivanwilli.github.io/DemoKin/articles/1_3_TwoSex_TimeInvariant_Age.html)
+- [Two-sex time-varying kinship
+ model](https://ivanwilli.github.io/DemoKin/articles/1_4_TwoSex_TimeVarying_Age.html)
+
+### Models stratified by age and stage
+
+- [One-sex time-invariant multi-state
+ model](https://ivanwilli.github.io/DemoKin/articles/2_1_OneSex_TimeInvariant_AgeStage.html)
+- [Two-sex time-varying multi-state
+ model](https://ivanwilli.github.io/DemoKin/articles/2_2_TwoSex_TimeVarying_AgeStage.html)
+
+## Contributors
-
-
-Relatives are identified by a unique code:
-
-| DemoKin | Label |
-|:--------|:---------------------------|
-| coa | Cousins from older aunt |
-| cya | Cousins from younger aunt |
-| d | Daughter |
-| gd | Grand-daughter |
-| ggd | Great-grand-daughter |
-| ggm | Great-grandmother |
-| gm | Grandmother |
-| m | Mother |
-| nos | Nieces from older sister |
-| nys | Nieces from younger sister |
-| oa | Aunt older than mother |
-| ya | Aunt younger than mother |
-| os | Older sister |
-| ys | Younger sister |
-
-## Vignette
-
-For more details, including an extension to time varying-populations
-rates, deceased kin, and multi-state models, see
-`vignette("Reference", package = "DemoKin")`. If the vignette does not
-load, you may need to install the package as
-`devtools::install_github("IvanWilli/DemoKin", build_vignettes = T)`.
+`DemoKin` has benefited from the work of many people over the years,
+including:
+
+- **Ivan Williams** (University of Buenos Aires) leads the technical
+ development of `DemoKin` with a particular focus on the implementation
+ of the functions in R.
+
+- **Diego Alburez-Gutierrez** (Max Planck Institute for Demographic
+ Research) coordinates the development of the package.
+
+- **Hal Caswell** (University of Amsterdam) provided crucial MATLAB code
+ for computing matrix kinship models.
+
+- **Xi Song** (University of Pennsylvania) contributed the code to
+ estimate time variant kinship models.
+
+- **Benjamin Schlüter** (University of Toronto) contributed code to
+ implement bereavement analysis by cause of death.
+
+- **Joe Butterick** (University of Southampton) contributed code to
+ implement time-variant, two-sex multistate kinship models.
+
+- **Jason Hilton** (University of Southampton) contributed code to
+ implement time-variant, two-sex multistate kinship models.
+
+- **Sha Jiang** (Max Planck Institute for Demographic Research) helped
+ create and organise the documention for the package, including
+ developing the package’s website.
+
+- **Amanda Martins** (Max Planck Institute for Demographic Research)
+ developed materials for teaching DemoKin, including a course at the
+ [European Doctoral School of
+ Demography](https://amandamartinsal.github.io/EDSD_kinship_24-25/).
## Citation
-Williams, Iván; Alburez-Gutierrez, Diego; Song, Xi; and Hal Caswell.
-(2021) DemoKin: An R package to implement demographic matrix kinship
-models. URL: .
+Williams, Iván; Alburez-Gutierrez, Diego; and the DemoKin team. (2021)
+DemoKin: An R package to implement demographic matrix kinship models.
+URL: .
## Acknowledgments
@@ -117,27 +157,11 @@ Commons. Sha Jiang provided useful comments for improving the package.
## Get involved!
`DemoKin` is under constant development. If you’re interested in
-contributing, please get in touch, create an issue, or submit a pull
+contributing, please get in touch, create an
+[issue](https://github.com/IvanWilli/DemoKin/issues), or submit a pull
request. We look forward to hearing from you!
-## References
-
-Caswell, H. 2019. The formal demography of kinship: A matrix
-formulation. Demographic Research 41:679–712.
-.
-
-Caswell, H. 2020. The formal demography of kinship II: Multistate
-models, parity, and sibship. Demographic Research 42: 1097-1144.
-.
-
-Caswell, Hal and Xi Song. 2021. “The Formal Demography of Kinship. III.
-Kinship Dynamics with Time-Varying Demographic Rates.” Demographic
-Research 45: 517–46. .
-
-Goodman, L.A., Keyfitz, N., and Pullum, T.W. (1974). Family formation
-and the frequency of various kinship relationships. Theoretical
-Population Biology 5(1):1–27. .
+## License
-
-
-
+This project is licensed under the MIT License - see the LICENSE file
+for details.
diff --git a/_pkgdown.yml b/_pkgdown.yml
new file mode 100644
index 0000000..164bfbc
--- /dev/null
+++ b/_pkgdown.yml
@@ -0,0 +1,52 @@
+url: https://ivanwilli.github.io/DemoKin/
+template:
+ params:
+ bootstrap: 5
+ bootswatch: united
+
+navbar:
+ title: "DemoKin"
+ structure:
+ left: [home, tutorials, reference, articles]
+ right: [github]
+ components:
+ home:
+ strip_header: true
+ title: DemoKin
+ description: Demographic analysis of kinship networks using matrix-based models.
+ icon: fas fa-home fa-lg
+ href: index.html
+ tutorials:
+ text: "Tutorials"
+ menu:
+ - text: "One-sex time-invariant model"
+ href: articles/1_1_OneSex_TimeInvariant_Age.html
+ - text: "One-sex time-varying model"
+ href: articles/1_2_OneSex_TimeVarying_Age.html
+ - text: "Two-sex time-invariant model"
+ href: articles/1_3_TwoSex_TimeInvariant_Age.html
+ - text: "Two-sex time-varying model"
+ href: articles/1_4_TwoSex_TimeVarying_Age.html
+ - text: "One-sex time-invariant Age-Stage model"
+ href: articles/2_1_OneSex_TimeInvariant_AgeStage.html
+ - text: "Two-sex time-varying Age-Stage model"
+ href: articles/2_2_TwoSex_TimeVarying_AgeStage.html
+ reference:
+ text: "Functions"
+ href: reference/index.html
+ articles:
+ text: "Articles"
+ href: articles/0_0_Papers.html
+ github:
+ icon: fab fa-github fa-lg
+ href: https://github.com/IvanWilli/DemoKin
+
+# reference:
+# - title: "Model estimation"
+# desc: "Estimate kinship count distribution"
+# contents:
+# - starts_with("kin")
+# - title: "Kinship diagram"
+# desc: "Visualize a kinship diagram"
+# contents:
+# - starts_with("plot")
diff --git a/cran-comments.md b/cran-comments.md
new file mode 100644
index 0000000..998da63
--- /dev/null
+++ b/cran-comments.md
@@ -0,0 +1,5 @@
+## R CMD check results
+
+0 errors | 0 warnings | 1 note
+
+* This is a new release. I replaced the use of par(), which created some problems, with ggplot tools. Hope solves the issue.
diff --git a/data/F_mat_fem_edu.rda b/data/F_mat_fem_edu.rda
new file mode 100644
index 0000000..d61a00a
Binary files /dev/null and b/data/F_mat_fem_edu.rda differ
diff --git a/data/F_mat_male_edu.rda b/data/F_mat_male_edu.rda
new file mode 100644
index 0000000..728bb47
Binary files /dev/null and b/data/F_mat_male_edu.rda differ
diff --git a/data/Female_parity_fert_list_UK.rda b/data/Female_parity_fert_list_UK.rda
new file mode 100644
index 0000000..d121ded
Binary files /dev/null and b/data/Female_parity_fert_list_UK.rda differ
diff --git a/data/Female_parity_mortality_list_UK.rda b/data/Female_parity_mortality_list_UK.rda
new file mode 100644
index 0000000..b4a8d7e
Binary files /dev/null and b/data/Female_parity_mortality_list_UK.rda differ
diff --git a/data/H_mat_edu.rda b/data/H_mat_edu.rda
new file mode 100644
index 0000000..0c67b3b
Binary files /dev/null and b/data/H_mat_edu.rda differ
diff --git a/data/Male_parity_fert_list_UK.rda b/data/Male_parity_fert_list_UK.rda
new file mode 100644
index 0000000..6e0b5b1
Binary files /dev/null and b/data/Male_parity_fert_list_UK.rda differ
diff --git a/data/Male_parity_mortality_list_UK.rda b/data/Male_parity_mortality_list_UK.rda
new file mode 100644
index 0000000..86e1a55
Binary files /dev/null and b/data/Male_parity_mortality_list_UK.rda differ
diff --git a/data/Parity_transfers_by_age_list_UK.rda b/data/Parity_transfers_by_age_list_UK.rda
new file mode 100644
index 0000000..1a8932c
Binary files /dev/null and b/data/Parity_transfers_by_age_list_UK.rda differ
diff --git a/data/Redistribution_by_parity_list_UK.rda b/data/Redistribution_by_parity_list_UK.rda
new file mode 100644
index 0000000..7fc1078
Binary files /dev/null and b/data/Redistribution_by_parity_list_UK.rda differ
diff --git a/data/T_mat_fem_edu.rda b/data/T_mat_fem_edu.rda
new file mode 100644
index 0000000..c33afc3
Binary files /dev/null and b/data/T_mat_fem_edu.rda differ
diff --git a/data/T_mat_male_edu.rda b/data/T_mat_male_edu.rda
new file mode 100644
index 0000000..793ed1e
Binary files /dev/null and b/data/T_mat_male_edu.rda differ
diff --git a/data/U_mat_fem_edu.rda b/data/U_mat_fem_edu.rda
new file mode 100644
index 0000000..06c2337
Binary files /dev/null and b/data/U_mat_fem_edu.rda differ
diff --git a/data/U_mat_male_edu.rda b/data/U_mat_male_edu.rda
new file mode 100644
index 0000000..8030dbb
Binary files /dev/null and b/data/U_mat_male_edu.rda differ
diff --git a/data/demokin_codes.rda b/data/demokin_codes.rda
new file mode 100644
index 0000000..8ab6620
Binary files /dev/null and b/data/demokin_codes.rda differ
diff --git a/data/fra_asfr_sex.rda b/data/fra_asfr_sex.rda
new file mode 100644
index 0000000..5572499
Binary files /dev/null and b/data/fra_asfr_sex.rda differ
diff --git a/data/fra_surv_sex.rda b/data/fra_surv_sex.rda
new file mode 100644
index 0000000..abef45f
Binary files /dev/null and b/data/fra_surv_sex.rda differ
diff --git a/data/swe_surv.rda b/data/swe_surv.rda
deleted file mode 100644
index f00af74..0000000
Binary files a/data/swe_surv.rda and /dev/null differ
diff --git a/dev/.DS_Store b/dev/.DS_Store
deleted file mode 100644
index 1e69428..0000000
Binary files a/dev/.DS_Store and /dev/null differ
diff --git a/dev/PENDS.txt b/dev/PENDS.txt
deleted file mode 100644
index ecbf143..0000000
--- a/dev/PENDS.txt
+++ /dev/null
@@ -1,7 +0,0 @@
-1) Set no specific argument for Pb: in the case the user wants to use it, that can be included by her/himself in the F matrix, implicitly. - ok
-1.1) caswell´s assumption stable: ft[1,1:ages] = f * U * birth_female
-2) Include a paragraph in the "using" vignette to show this option.
-3) Non-stable without pi or N as argument: give user an output anyways and a message "A stable assumption was used for the age distribution of the mother in each input year".
-4) Replicate Hal´s output for dinamycs.
-5) Correct the appendix: survival/probabilities.
-6) Finish Multi-stage.
\ No newline at end of file
diff --git a/dev/calling_kinship_SVK_4867.m b/dev/calling_kinship_SVK_4867.m
deleted file mode 100644
index f51c641..0000000
--- a/dev/calling_kinship_SVK_4867.m
+++ /dev/null
@@ -1,86 +0,0 @@
-%script to calculate kinship results
-%this script calls the function kinship_function_parity_4867
-%requires the function vecperm.m to create vec-permutation matrix
-%
-% Supplement to:
-% Caswell, H. 2020. The formal demography of kinship II. Multistate models,
-% parity, and sibship. Demographic Research 42:1097-1144
-%
-% Has been successfully used under Matlab R2018b
-
-%specify range of years to analyze
-years=1960:2014;
-
-%years=2002;
-
-numyears=length(years); %specific to SVK data
-%add path to location of matrices
-addpath('SVK_kinmats/')
-
-for iy=1:numyears
- year=years(iy)
-
- %specify name of matrix file
- fname=char(['SVKmats' num2str(1950+iy-1) '.mat']);
- %load matrix file
- load(fname)
-
- %create the block diagonal matrices
-
- %identity matrices that are useful
- Iom=eye(om);
- Is=eye(s);
-
- bbU=zeros(s*om);
- bbF=zeros(s*om);
- for i=1:om
- bbU = bbU + kron(Iom(:,i)*Iom(i,:),U{i});
- bbF = bbF + kron(Iom(:,i)*Iom(i,:),F{i});
- end
- bbD=zeros(s*om);
- bbH=zeros(s*om);
- for i=1:s
- bbD = bbD+kron(Is(:,i)*Is(i,:),D{i});
- bbH = bbH+kron(Is(:,i)*Is(i,:),H{i});
- end
-
- %create the age-stage matrices using the vec permuation formula
- K=vecperm(s,om);
- Ut= K'*bbD*K*bbU;
- Ft= K'*bbH*K*bbF;
-
- %conditional transition matrix, conditional on survival
- Gt=Ut*pinv(diag(sum(Ut)));
-
- %calculate distributions of mothers
- %projection matrix Atilde
- At=Ut+Ft;
- %eigenvalues and right eigenvectors
- [wt,d]=eig(At);
- d=diag(d);
- %find maximum eigenvalue
- pick=find(d==max(d));
- wt=wt(:,pick);
- %stable age-parity distribution normalized to sum to 1
- wt=wt/sum(wt);
- lambda=d(pick)
-
- %age-stage distribution of mothers
- pit=Ft(1,:)'.*wt;
- pit=pit/sum(pit);
- %marginal age distribution of mothers
- piage=kron(Iom,ones(s,1)')*pit;
-
- clear At
-
- %add path to call the kinship program
- path('../',path)
-
- %call the kinship function
- kinout=kinship_function_parity(Ut,Ft,Gt,wt,pit,piage);
-
- %save the kin output
- %include path to output folder
- myname=char(['SVK_kinout/SVKkinout' num2str(years(iy)) '.mat'])
- save(myname,'kinout')
-end
diff --git a/dev/kinship_function_parity_4867.m b/dev/kinship_function_parity_4867.m
deleted file mode 100644
index 897bcdb..0000000
--- a/dev/kinship_function_parity_4867.m
+++ /dev/null
@@ -1,199 +0,0 @@
-function out=kinship_function_parity(Ut,Ft,Gt,wt,pit,piage)
-%
-%function to compute kinship network for multistate age x parity model
-% Supplement to:
-% Caswell, H. 2020. The formal demography of kinship II. Multistate models,
-% parity, and sibship. Demographic Research 42:1097-1144
-%
-% Has been successfully used under Matlab R2018b
-%
-%
-%inputs
-% Ut=age-stage transition matrix
-% Ft = age-stage fertility matrix
-% Gt=age-stage transition matrix conditional on survival
-% wt=stable age-stage distribution, normalized to sum to 1
-% pit=age-stage distribution of mothers
-% piage = marginal age distribution of mothers
-
-
-%number of age classes
-om=length(piage);
-%number of stages
-s=length(pit)/om;
-
-%identity matrices useful in calculations
-Iom=eye(om);
-Is=eye(s);
-Isom=eye(s*om);
-
-%frequently used zero vector for initial condition
-zvec=zeros(s*om,1);
-
-%frequently used om-1 limit for iterations
-omz=om-1;
-
-% the following code calculates age-stage distributions,
-% for each type of kin, for each age x of Focal,
-% and stores these as columns of an array
-% e.g., a(x) = daughters at age x; A(:,x) contains a(x)
-
-% dynamics of Focal
-% initial condition
-phiz=zeros(s*om,1);
-phiz(1)=1;
-%age-stage vector of Focal, conditional on survival
-Phi(:,1)=phiz;
-for ix=1:omz
- Phi(:,ix+1)=Gt*Phi(:,ix);
-end
-
-% a: daughters of focal
-
-az=zvec;
-A(:,1)=az;
-for ix=1:omz
- A(:,ix+1)=Ut*A(:,ix) + Ft*Phi(:,ix);
-end % for ix
-
-
-% b = granddaughters of Focal
-b=zvec;
-B(:,1)=b;
-for ix=1:omz
- B(:,ix+1)=Ut*B(:,ix) + Ft*A(:,ix);
-end
-
-
-% c = greatgranddaughters of Focal
-c=zvec;
-C(:,1)=c;
-for ix=1:omz
- C(:,ix+1)=Ut*C(:,ix) +Ft*B(:,ix);
-end
-
-
-% d = mothers of Focal
-% conditional on mother having parity >0
-
-%momarray is an array with pit in each column
-momarray=pit*ones(1,om);
-
-Z=eye(s);
-Z(1,1)=0;
-for imom=1:om %go through all columns of momarray
- E=Iom(:,imom)*Iom(imom,:);
- momarray(:,imom)=kron(E,Z)*momarray(:,imom);
- %selects age imom, and eliminates the zero parity row of momarray
-
-end
-%rescale columns of momarray to sum to 1
-momarray=momarray*pinv(diag(sum(momarray)));
-
-%set dzero to the average of the momarray over the ages of moms at birth of
-%children
-dzero=momarray*piage;
-
-D(:,1)=dzero;
-for ix=1:omz
- D(:,ix+1)=Ut*D(:,ix);
-end
-
-
-% g = maternal grandmothers of Focal
-gzero=D*piage;
-
-G(:,1)=gzero;
-for ix=1:omz
- G(:,ix+1)=Ut*G(:,ix);
-end
-
-
-% h = great-grandmothers of Focal
-hzero=G*piage;
-H(:,1)=hzero;
-for ix=1:omz
- H(:,ix+1)=Ut*H(:,ix) + 0;
-end
-
-% m = older sisters of Focal
-mzero=A*piage;
-M(:,1)=mzero;
-for ix=1:omz
- M(:,ix+1)=Ut*M(:,ix) + 0;
-end
-
-% n = younger sisters of Focal
-nzero=zvec;
-N(:,1)=nzero;
-for ix=1:omz
- N(:,ix+1)=Ut*N(:,ix) + Ft*D(:,ix);
-end
-
-
-% p = nieces through older sisters of Focal
-pzero=B*piage;
-P(:,1)=pzero;
-for ix=1:omz
- P(:,ix+1)=Ut*P(:,ix) + Ft*M(:,ix);
-end
-
-% q = nieces through younger sisters of Focal
-qzero=zvec;
-Q(:,1)=qzero;
-for ix=1:omz
- Q(:,ix+1)=Ut*Q(:,ix) + Ft*N(:,ix);
-end
-
-% r = aunts older than mother of Focal
-rzero=M*piage;
-R(:,1)=rzero;
-for ix=1:omz
- R(:,ix+1)=Ut*R(:,ix) + 0;
-end
-
-% s = aunts younger than mother of Focal
-szero=N*piage;
-S(:,1)=szero;
-for ix=1:omz
- S(:,ix+1)=Ut*S(:,ix) + Ft*G(:,ix);
-end
-
-% t = cousins from aunts older than mother of Focal
-tzero=P*piage;
-T(:,1)=tzero;
-for ix=1:omz
- T(:,ix+1)=Ut*T(:,ix) + Ft*R(:,ix);
-end
-
-
-% v = cousins from aunts younger than mother of Focal
-vzero=Q*piage;
-V(:,1)=vzero;
-for ix=1:omz
- V(:,ix+1)=Ut*V(:,ix) + Ft*S(:,ix);
-end %for i
-
-
-%overall kinship matrices, concatenating all kin
-allkin=cat(3,A,B,C,D,G,H,M,N,P,Q,R,S,T,V);
-
-%combining older and younger categories
-% for sisters, neices, aunts, and cousins
-allkin2=cat(3,A,B,C,D,G,H,M+N,P+Q,R+S,T+V);
-
-%output structure
-out.allkin=allkin;
-out.allkin2=allkin2;
-out.Phi=Phi;
-out.pit=pit;
-out.piage=piage;
-out.om=om;
-out.s=s;
- out.Ut=Ut;
-out.Ft=Ft;
-out.Gt=Gt;
-
-
-
-
diff --git a/dev/matrix_construction_4867.m b/dev/matrix_construction_4867.m
deleted file mode 100644
index 1f6c75e..0000000
--- a/dev/matrix_construction_4867.m
+++ /dev/null
@@ -1,102 +0,0 @@
-
-% script to prepare matrices for multistate age x parity model
-% Supplement to:
-% Caswell, H. 2020. The formal demography of kinship II. Multistate models,
-% parity, and sibship. Demographic Research 42:1097-1144
-%
-%requires Matlab Table files obtained from HMD (fltper) and HFD (mi)
-% Has been successfully used under Matlab R2018b
-
-%add folder contraining the table files to path
-addpath('SVK_tables/')
-
-% load the female lifetable file
-load('SVKfltperTable.mat')
-%columns in this Table: Year,Age,mx,qx,ax,lx,dx,Lx,Tx,ex
-lt=ltable;
-
-%load the parity state transition file
-load('SVKmiTable.mat')
-%columns: Year,Age,mi1,mi2,mi3,mi4,mi5p
-
-%find year ranges
-minfertyear=min(fert.Year);
-maxfertyear=max(fert.Year);
-
-minltyear=min(lt.Year);
-maxltyear=max(lt.Year);
-
-%pick a starting year and ending year
-startyear=max([minfertyear minltyear]);
-endyear=min([maxfertyear maxltyear]);
-
-%array of years and number of years
-years=startyear:endyear;
-numyears=endyear-startyear+1;
-
-for iy=1:numyears
- years(iy);
-
- %find life table and qx array for year iy
- pick=find(lt.Year==years(iy));
- qx=table2array(lt(pick,4));
-
- %find fertility and create fertility array
- pick=find(fert.Year==years(iy));
- fertarray=table2array(fert(pick,[2:7]));
-
- %number of age classes
- %om=length(qx)-1;
- om=length(qx)-1;
- %number of parity classes
- s=6;
-
- %extend the fertility array
- startfert=fertarray(1,1);
- endfert=fertarray(end,1);
- %put zeros before age of first reproduction
- fertarray=[zeros(startfert-1,6); fertarray];
- fertarray(1:startfert-1,1)=(1:startfert-1)';
- %put zeros after age of last reproduction
- fertarray=[fertarray; zeros(om-endfert,6)];
- fertarray(endfert+1:om,1)=(endfert+1:om)';
-
- %remove age column from fertarray
- fertarray=fertarray(:,2:6);
-
- %construct the stage transition matrices using probabilities
- for i=1:om
- U{i} = diag(fertarray(i,:),-1);
- %transform subdiagonals to probabilities
- U{i}=U{i}./(1+0.5*U{i});
- %fill in diagonal entries
- U{i}=U{i}+diag([1-diag(U{i},-1) ; 1]);
- end
-
- %construct the age transition and survival matrices
- for i=1:s
- D{i}=diag(1-qx(1:om-1),-1);
- end
-
- %construct fertility matrices
- for i=1:om
- F{i}=zeros(s,s);
- F{i}(1,1:s-1)=diag(U{i},-1);
- F{i}(1,s)=U{i}(s,s-1);
- %divide fertility by 2
- F{i}=F{i}/2;
- end
-
- %stage assignment matrices
- for i=1:s
- H{i}=zeros(om,om);
- H{i}(1,:)=1;
- end
-
- %include path to folder where matrix files are to be stored
- myname=char(['SVK_kinmats/SVKmats' num2str(years(iy)) '.mat'])
- %save the matrices into a .mat file
- save(myname,'U','D','F','H','om','s')
-
-end
-
diff --git a/dev/readme.txt b/dev/readme.txt
deleted file mode 100644
index e69de29..0000000
diff --git a/dev/tests/repl_caswell.R b/dev/tests/repl_caswell.R
deleted file mode 100644
index b81c5ee..0000000
--- a/dev/tests/repl_caswell.R
+++ /dev/null
@@ -1,443 +0,0 @@
-# replicating Caswell´s figures: choose some kin
-
-library(devtools)
-load_all()
-library(DemoKin)
-library(tidyverse)
-library(progress)
-library(R.matlab)
-load("tests/test.RData")
-
-# basic
-debugonce(kin_time_variant)
-swe_kin_period_pack <- kin(U = swe_surv,
- f = swe_asfr,
- N = swe_pop,
- time_invariant = F,
- birth_female = 1,
- output_period = c(1900, 1950, 2010),
- output_kin = c("d","gd","m","gm","oa", "os"))
-
-swe_kin_period_pack$kin_full %>%
- filter(alive == "yes") %>%
- group_by(age_focal, kin, year) %>%
- summarise(count = sum(count, na.rm=T)) %>%
- ggplot(aes(age_focal, count, color=factor(year))) +
- geom_line() +
- facet_wrap(~kin, scales="free_y")
-
-# time variant ------------------------------------------------------------
-
-# inputs
-input_time_variant <- readMat("tests/SWEhist_matrices.mat")
-input_time_variant_proj <- readMat("tests/SWEproj_matrices.mat")
-# class(input_time_variant)
-# names(input_time_variant)
-# length(input_time_variant[["matrices"]]) # number of years
-# input_time_variant[["matrices"]][[128]][[1]][[1]] # U
-# input_time_variant[["matrices"]][[1]][[1]][[2]] # F
-# input_time_variant[["matrices"]][[1]][[1]][[3]] # popsize
-# input_time_variant[["matrices"]][[1]][[1]][[4]] # pi
-# length(input_time_variant_proj[["matrices"]]) # number of years
-
-U_hal <- f_hal <-N_hal <- pi_hal <-matrix(rep(0,111))
-for(y in 1:128){
- # y = 1
- U <- input_time_variant[["matrices"]][[y]][[1]][[1]] %>% as.matrix()
- f <- input_time_variant[["matrices"]][[y]][[1]][[2]] %>% as.matrix()
- N <- input_time_variant[["matrices"]][[y]][[1]][[3]] %>% as.matrix()
- pi <- input_time_variant[["matrices"]][[y]][[1]][[4]] %>% as.matrix()
- U_hal <- cbind(U_hal, c(U[col(U)==row(U)-1], U[ncol(U),nrow(U)]))
- f_hal <- cbind(f_hal ,f[1,])
- N_hal <- cbind(N_hal ,N)
- pi_hal <-cbind(pi_hal, pi)
-}
-U_hal_end <- U_hal[,-1]
-f_hal_end <- f_hal[,-1]
-N_hal_end <- N_hal[,-1]
-pi_hal_end <-pi_hal[,-1]
-colnames(U_hal_end) <- colnames(f_hal_end) <- colnames(N_hal_end) <- colnames(pi_hal_end) <-1891:2018
-dim(U_hal_end);class(U_hal_end %>% as.matrix)
-
-# period
-swe_kin_period <- kin(U = U_hal_end %>% as.matrix(),
- f = f_hal_end %>% as.matrix(),
- pi = pi_hal_end %>% as.matrix(),
- time_invariant = F,
- birth_female = 1,
- output_period = c(1891,1921,1951,2010),
- output_kin = c("d","gd","m","gm","oa", "os"))
-
-# check first-row plots from figures 5-A and 5-B from https://www.demographic-research.org/volumes/vol45/16/45-16.pdf
-swe_kin_period$kin_full %>%
- filter(alive == "yes") %>%
- group_by(age_focal, kin, year) %>%
- summarise(count = sum(count, na.rm=T)) %>%
- ggplot(aes(age_focal, count, color=factor(year))) +
- geom_line() +
- facet_wrap(~kin, scales="free_y")
-
-# read from https://www.dropbox.com/t/3YiILmn7SpczN3oM
-output_time_variant <- readMat("tests/time-varying_sweden.mat")
-
-# inspect the way the package reads
-# class(output_time_variant)
-# names(output_time_variant)
-# length(output_time_variant[["allkin"]]) # number of years
-# length(output_time_variant[["allkin"]][[1]])
-# length(output_time_variant[["allkin"]][[1]])
-# class(output_time_variant[["allkin"]][[1]][[1]]) # 1 array with kin matrix
-# dim(output_time_variant[["allkin"]][[1]][[1]][,,14]) # the matrix of the nth kin, 111 ages
-
-# use own codes to interpret
-codes <- c("coa", "cya", "d", "gd", "ggd", "ggm", "gm", "m", "nos", "nys", "oa", "ya", "os", "ys")
-caswell_codes <- c("t", "v", "a", "b", "c", "h", "g", "d", "p", "q", "r", "s", "m", "n")
-
-# re arrange all data to a dataframe
-output_time_variant_df <- map_df(1:128, function(i){
- array_branch(output_time_variant[["allkin"]][[i]][[1]], margin = 3) %>%
- map_df(., as.data.frame)}) %>%
- setNames(as.character(0:110)) %>%
- bind_cols(crossing(year = 1891+(0:127),
- kin_index = 1:14,
- age_kin = 0:110)) %>%
- inner_join(tibble(kin = codes, caswell_codes) %>%
- arrange(caswell_codes) %>% mutate(kin_index = 1:14))
-
-# check dimension: 128 years, 14 types of kin, 111 ages
-nrow(output_time_variant_df); 128*14*111
-
-# check first-row plots from figures 5-A and 5-B from https://www.demographic-research.org/volumes/vol45/16/45-16.pdf
-output_time_variant_df %>%
- filter(year %in% c(1891,1921,1951,2010), kin %in% c("d","gd", "m", "gm", "oa", "os")) %>%
- pivot_longer(`0`:`110`, names_to = "age", values_to = "count") %>%
- mutate(age = as.integer(age)) %>%
- group_by(age, kin, year) %>%
- summarise(count = sum(count)) %>%
- ggplot(aes(age, count, color=factor(year))) +
- geom_line() +
- facet_wrap(~kin, scales="free_y")
-
-# differences - look d, gd, in 1891 and 1951
-swe_period_together <- swe_kin_period$kin_full %>%
- filter(alive == "yes") %>%
- filter(year %in% c(1891,1921,1951,2010), kin %in% c("d","gd","m","gm","oa", "os")) %>%
- group_by(age_focal, kin, year) %>% summarise(count_demokin = sum(count, na.rm=T)) %>%
- inner_join(
- output_time_variant_df %>%
- filter(year %in% c(1891,1921,1951,2010), kin %in% c("d","gd", "m", "gm","oa", "os")) %>%
- pivot_longer(`0`:`110`, names_to = "age", values_to = "count") %>%
- mutate(age = as.integer(age)) %>%
- group_by(age_focal=age, kin, year) %>%
- summarise(count_paper = sum(count)))
-
-swe_period_together %>%
- filter(year == 1891) %>%
- ggplot() +
- geom_line(aes(age_focal, count_demokin, color=factor(year)), linetype=1) +
- geom_line(aes(age_focal, count_paper, color=factor(year)), linetype=2) +
- facet_wrap(~kin, scales="free_y")
-
-swe_period_rel_dif <- swe_period_together %>%
- mutate(rel_dif = round(100*(count_paper/count_demokin-1),3)) %>%
- arrange(year, kin) %>%
- as.data.frame() %>%
- group_by(year, kin) %>% summarise(sum(rel_dif, na.rm=T))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-# to bind projected
-# U_hal <- U_hal[1:106,]
-# f_hal <- f_hal[1:106,]
-# N_hal <- N_hal[1:106,]
-# pi_hal <-pi_hal[1:106,]
-# for(y in 1:102){
-# # y = 1
-# U <- input_time_variant_proj[["matrices"]][[y]][[1]][[1]]
-# f <- input_time_variant_proj[["matrices"]][[y]][[1]][[2]]
-# N <- input_time_variant_proj[["matrices"]][[y]][[1]][[3]]
-# pi <- input_time_variant_proj[["matrices"]][[y]][[1]][[4]]
-# U_hal <- U_hal %>% bind_cols(c(U[col(U)==row(U)-1], U[ncol(U),nrow(U)]))
-# f_hal <- f_hal %>% bind_cols(f[1,])
-# N_hal <- N_hal %>% bind_cols(N)
-# pi_hal <-pi_hal%>% bind_cols(as.numeric(pi))
-# }
-# dim(U_hal[,-1])
-# U_hal_end <- U_hal[,-1] %>% setNames(as.character(1891:2120))
-# f_hal_end <- f_hal[,-1] %>% setNames(as.character(1891:2120))
-# N_hal_end <- N_hal[,-1] %>% setNames(as.character(1891:2120))
-# pi_hal_end <-pi_hal[,-1] %>% setNames(as.character(1891:2120))
-# dim(U_hal_end);names(U_hal_end)
-
-# time invariant ----------------------------------------------------------
-
-### data: survival probability and fertility by age for Japan
-# available at https://www.demographic-research.org/volumes/vol41/24/default.htm
-
-p_1947 <- 1 - read.csv("tests/qx_years.csv", header = F, sep = " ")[[4]]
-f_1947 <- read.csv("tests/fx_years.csv", header = F, sep = " ")[[4]]
-p_2014 <- 1 - read.csv("tests/qx_years.csv", header = F, sep = " ")[[205]]
-f_2014 <- read.csv("tests/fx_years.csv", header = F, sep = " ")[[205]]
-
-# Caswell assumption on first age
-f_1947 <- f_1947 * p_1947
-f_2014 <- f_2014 * p_2014
-
-kins_japan_1947 <- kin(p_1947, f_1947, living = F)$kin_full
-kins_japan_1947 %>%
- filter(alive=="yes", kin=="ggm") %>%
- group_by(age_focal) %>% summarise(sum(count))
-
-
-### results
-kins_japan <- rbind(tibble(Year = 1947, kin(p_1947, f_1947, living = F)$kin_full),
- tibble(Year = 2014, kin(p_2014, f_2014, living = F)$kin_full))
-
-# kins alive by age when ego is aged 30 or 70
-kins_japan %>%
- filter(age_focal %in% c(30,70), alive=="yes") %>%
- ggplot() +
- geom_line(aes(x=age_kin, y=count,
- color=factor(age_focal), linetype=factor(Year))) +
- facet_wrap(~kin,scales = "free_y") +
- theme_classic() +
- facet_wrap(~kin,scales = "free_y")
-
-kins_japan %>%
- filter(age_focal %in% 30, alive=="yes", kin == "m", Year==2014)
-
-### get paper results: done with https://plotdigitizer.com/app
-
-m_30_2014 <- c(48.124993716677295, 0.0068724848600042006,
- 52.13541022398433, 0.022765097394085585,
- 56.14582673129136, 0.056697985757917374,
- 60.04166165822103, 0.07398657677157613,
- 64.16665974590543, 0.054765100671140945,
- 68.17707625321246, 0.02330201014576342,
- 71.95832959976478, 0.0035436192454907658) %>% matrix(ncol=2, byrow = T) %>%
- as.data.frame() %>% setNames(c("age_kin","count")) %>%
- mutate(kin = "m", year = 2014, age = 30)
-m_30_1947 <- c(47.89583055592257, 0.010630874121749168,
- 51.791665482852245, 0.045100671140939595,
- 56.37499863406029, 0.05111409232120386,
- 59.92708007784368, 0.03908724586435613,
- 63.82291500477335, 0.02577181208053692,
- 68.17707625321246, 0.012671136024014266,
- 71.84374801938742, 0.0025771828465813683) %>% matrix(ncol=2, byrow = T) %>%
- as.data.frame() %>% setNames(c("age_kin","count")) %>%
- mutate(kin = "m", year = 1947, age = 30)
-s_30_1947 <- c(117.30467373388943, 0.028030307190039253,
- 3.8671896129379024, 0.0011363654972982584,
- 8.05663990468026, 0.005681817853417949,
- 12.031249743886312, 0.01792929767285178,
- 16.220700035628674, 0.036111111913867226,
- 19.873045098211307, 0.05782828333912762,
- 23.84765903523633, 0.07626262618964844,
- 28.037105229159724, 0.08244949644554042,
- 32.119139392452894, 0.06717171906914071,
- 36.09374513383999, 0.044696973856705915,
- 39.853510422690775, 0.024621210698144477,
- 43.93554458598395, 0.010858592937435215,
- 47.80273010110288, 0.00303030478177092) %>% matrix(ncol=2, byrow = T) %>%
- as.data.frame() %>% setNames(c("age_kin","count")) %>%
- mutate(kin = "s", year = 1947, age = 30)
-s_70_1947 <- c(43.93554458598395, 0.0011363654972982584,
- 47.80273010110288, 0.00441919166376952,
- 52.20702494320051, 0.013383845316732092,
- 56.074218653957374, 0.026388889290266948,
- 59.94140416907631, 0.03952020358922534,
- 64.02343013673156, 0.048358586916764375,
- 68.10546430002474, 0.045959600046354354,
- 71.97264981514367, 0.03143939886539736,
- 76.05468397843684, 0.015404045293554923,
- 80.02928971982392, 0.005429296468717607,
- 84.00390365684893, 0.0011363654972982584) %>% matrix(ncol=2, byrow = T) %>%
- as.data.frame() %>% setNames(c("age_kin","count")) %>%
- mutate(kin = "s", year = 1947, age = 70)
-s_30_2014 <- c(7.949219678412107, 0.0005050524024740438,
- 12.031249743886312, 0.0032828357995446046,
- 16.005859583092366, 0.009217175037662914,
- 19.873045098211307, 0.020328289359798468,
- 23.6328103870621, 0.03194444645133473,
- 27.822264776623417, 0.03888889049440111,
- 32.01171916618474, 0.0337121250434572,
- 35.77148445503553, 0.0215909155494469,
- 39.96093884459685, 0.010732322612011683,
- 44.04296481225208, 0.0032828357995446046)%>% matrix(ncol=2, byrow = T) %>%
- as.data.frame() %>% setNames(c("age_kin","count")) %>%
- mutate(kin = "s", year = 2014, age = 30)
-s_70_2014 <- c(51.88476426439605, 0.002904044089420749,
- 56.18163888022552, 0.009343435730013084,
- 59.83398394280815, 0.01944444524720057,
- 64.13085855863763, 0.03068182026168629,
- 68.21288452629288, 0.035479798819043,
- 71.75780936260736, 0.03068182026168629,
- 76.16210420470499, 0.019318184554850383,
- 79.92186949355577, 0.008459601250488509,
- 84.00390365684893, 0.00265152270472039) %>% matrix(ncol=2, byrow = T) %>%
- as.data.frame() %>% setNames(c("age_kin","count")) %>%
- mutate(kin = "s", year = 2014, age = 70)
-
-output_time_invariant <- m_30_2014 %>%
- bind_rows(m_30_1947, s_30_1947, s_70_1947, s_30_2014, s_70_2014) %>%
- mutate(age_kin = trunc(age_kin), count=round(count,7))
-
-compare_time_invariant <- kins_japan %>%
- filter(kin %in% c("os", "ys"), alive == "yes") %>%
- group_by(Year, age_focal, age_kin, alive) %>%
- summarise(count = sum(count)) %>%
- mutate(kin = "s") %>%
- bind_rows(kins_japan %>% filter(alive == "yes")) %>%
- select(-year, -cohort, -alive) %>%
- rename(count_demokin = count, year = Year) %>%
- mutate(count_demokin = round(count_demokin,7)) %>%
- right_join(output_time_invariant %>%
- rename(age_focal=age, count_paper = count))
-
-compare_time_invariant %>%
- ggplot() +
- geom_line(aes(age_kin, count_demokin, linetype=factor(year)), col=1)+
- geom_line(aes(age_kin, count_paper, linetype=factor(year)), col=2) +
- facet_grid(~kin+age_focal)+
- theme_bw()
-
-
-### compare values
-
-
-
-
-
-
-
-
-
-
-# period
-swe_kin_period <- kin(U = U_caswell_2021, f = f_caswell_2021, pi = pi_caswell_2021, stable = F, birth_female = 1,
- focal_year = c(1891,1921,1951,2010,2050,2080,2120),
- selected_kin = c("d","gd","ggd","m","gm","ggm","os","ys","oa","ya"))
-
-swe_kin_period$kin_summary %>%
- ggplot(aes(age_focal,count,color=factor(year))) +
- geom_line(size=1)+
- scale_y_continuous(name = "",labels = seq(0,3,.2),breaks = seq(0,3,.2))+
- facet_wrap(~kin, scales = "free")+
- theme_bw()
-
-# ADDITIONAL PLOTS cohrot and period
-ggplot(swe_kin_cohorts$kin_summary %>% filter(cohort == 1911),
- aes(year,mean_age)) +
- geom_point(aes(size=count,color=kin)) +
- geom_line(aes(color=kin)) +
- scale_y_continuous(name = "Edad", breaks = seq(0,110,10), labels = seq(0,110,10), limits = c(0,110))+
- geom_segment(x = 1911, y = 0, xend = 2025, yend = 110, color = 1)+
- geom_vline(xintercept = 1911, linetype=2)+
- theme_light()+ coord_fixed()+
- labs(title = "Kin cohort 1911")
-
-swe_kin_period$kin_summary %>%
- filter(age_focal==50) %>%
- ggplot(aes(year, mean_age, color=kin)) +
- geom_point(aes(size=count)) +
- geom_line() +
- geom_hline(yintercept = 50, color=1, linetype=1)+
- theme_light()+
- coord_fixed()+
- labs(title = "Kin period")
-
-### plots
-# kins alive by age when ego is aged 30 or 70
-kins_japan %>%
- filter(age_focal %in% c(30,70), alive=="yes") %>%
- ggplot() +
- geom_line(aes(x=age_kin, y=count,
- color=factor(age_focal), linetype=factor(Year))) +
- facet_wrap(~kin,scales = "free_y") +
- theme_classic() +
- facet_wrap(~kin,scales = "free_y")
-# kins alive during ego´s life
-kins_japan %>%
- filter(alive=="yes") %>%
- group_by(Year, kin, age_focal) %>% summarise(count = sum(count)) %>%
- ggplot() +
- geom_line(aes(age_focal, count, linetype=factor(Year))) +
- theme_classic() +
- facet_wrap(~kin, scales = "free_y")
-# experienced deaths
-kins_japan %>%
- filter(alive=="no") %>%
- group_by(Year, kin, age_focal) %>% summarise(count = sum(count)) %>%
- ggplot() +
- geom_line(aes(age_focal, count, linetype=factor(Year))) +
- theme_classic() +
- facet_wrap(~kin, scales = "free_y")
-# variation coefficient of age by kin
-kins_japan %>%
- filter(alive=="yes") %>%
- group_by(Year, kin, age_focal) %>%
- summarise(mean_age = sum(count*age_kin)/sum(count),
- var_age = sum(count*age_kin^2)/sum(count) - mean_age^2,
- cv_age = round(sqrt(var_age)/mean_age*100,1)) %>%
- ggplot() +
- geom_line(aes(age_focal, cv_age, linetype=factor(Year))) +
- theme_classic() +
- facet_wrap(~kin, scales = "free_y")
-# dependency ages
-kins_japan %>%
- filter(alive=="yes") %>%
- mutate(age_kin_dep = ifelse(age_kin<15,"0-14",
- ifelse(age_kin<65,"15-64","65+"))) %>%
- group_by(Year, kin, age_focal, age_kin_dep) %>%
- summarise(count = sum(count)) %>%
- ggplot() +
- geom_line(aes(age_focal, count,
- color = age_kin_dep, linetype=factor(Year))) +
- theme_classic() +
- facet_wrap(~kin, scales = "free_y")
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-swe_surv_2010 <- swe_surv %>% pull(`2011`)
-swe_asfr_2010 <- swe_asfr %>% pull(`2011`)
-debugonce(kin)
-swe50_2015_stable <- kin(U = swe_surv_2010, f = swe_asfr_2010, output_cohort = c(1911,1930),
- output_kin = c("d","m"))
-
-swe_kin_cohorts <- kin(U = U_caswell_2021, f = f_caswell_2021, time_invariant = F,
- birth_female = 1,
- output_cohort = c(1911),
- output_kin = c("d"))
-
-U = U_caswell_2021; f = f_caswell_2021; pi = pi_caswell_2021; birth_female = 1;
-output_cohort = c(1911);output_period = NULL; output_kin = c("d")
-
-# FIGURE 5
-
-
-
diff --git a/dev/tests/repl_caswell_first_year.R b/dev/tests/repl_caswell_first_year.R
deleted file mode 100644
index c88c121..0000000
--- a/dev/tests/repl_caswell_first_year.R
+++ /dev/null
@@ -1,106 +0,0 @@
-# replicating Caswell´s figures: choose some kin
-library(DemoKin)
-library(tidyverse)
-library(R.matlab)
-source("R/kin_time_invariant.R")
-
-# paper input from https://www.demographic-research.org/volumes/vol45/16/45-16.pdf
-input_time_variant <- readMat("tests/SWEhist_matrices.mat")
-
-# check structure from reading mat
-class(input_time_variant)
-names(input_time_variant)
-length(input_time_variant[["matrices"]]) # number of years
-input_time_variant[["matrices"]][[128]][[1]][[1]] # U
-input_time_variant[["matrices"]][[1]][[1]][[2]] # F
-input_time_variant[["matrices"]][[1]][[1]][[3]] # popsize
-input_time_variant[["matrices"]][[1]][[1]][[4]] # pi
-length(input_time_variant_proj[["matrices"]]) # number of years
-
-# reshape
-U_hal <- f_hal <-N_hal <- pi_hal <-matrix(rep(0,111))
-for(y in 1:128){
- U <- input_time_variant[["matrices"]][[y]][[1]][[1]] %>% as.matrix()
- f <- input_time_variant[["matrices"]][[y]][[1]][[2]] %>% as.matrix()
- N <- input_time_variant[["matrices"]][[y]][[1]][[3]] %>% as.matrix()
- pi <- input_time_variant[["matrices"]][[y]][[1]][[4]] %>% as.matrix()
- U_hal <- cbind(U_hal, c(U[col(U)==row(U)-1], U[ncol(U),nrow(U)]))
- f_hal <- cbind(f_hal ,f[1,])
- N_hal <- cbind(N_hal ,N)
- pi_hal <-cbind(pi_hal, pi)
-}
-U_hal <- U_hal[,-1]
-f_hal <- f_hal[,-1]
-N_hal <- N_hal[,-1]
-pi_hal <-pi_hal[,-1]
-colnames(U_hal) <- colnames(f_hal) <- colnames(N_hal) <- colnames(pi_hal) <-1891:2018
-dim(U_hal);class(U_hal %>% as.matrix)
-
-# output from Hal (dropbox link https://www.dropbox.com/t/3YiILmn7SpczN3oM)
-output_time_variant <- readMat("tests/time-varying_sweden.mat")
-
-# inspect the way the package reads mat
-class(output_time_variant)
-names(output_time_variant)
-length(output_time_variant[["allkin"]]) # number of years
-length(output_time_variant[["allkin"]][[1]])
-length(output_time_variant[["allkin"]][[1]])
-class(output_time_variant[["allkin"]][[1]][[1]]) # 1 array with kin matrix
-dim(output_time_variant[["allkin"]][[1]][[1]][,,14]) # the matrix of the nth kin, 111 ages
-
-# use own codes to interpret
-codes <- c("coa", "cya", "d", "gd", "ggd", "ggm", "gm", "m", "nos", "nys", "oa", "ya", "os", "ys")
-caswell_codes <- c("t", "v", "a", "b", "c", "h", "g", "d", "p", "q", "r", "s", "m", "n")
-
-# re shape data to tidy
-output_time_variant_df <- map_df(1:128, function(i){
- array_branch(output_time_variant[["allkin"]][[i]][[1]], margin = 3) %>%
- map_df(., as.data.frame)}) %>%
- setNames(as.character(0:110)) %>%
- bind_cols(crossing(year = 1891+(0:127), # years
- kin_index = 1:14, # number of possible kin
- age_kin = 0:110) # ages
- ) %>%
- inner_join(tibble(kin = codes, caswell_codes) %>%
- arrange(caswell_codes) %>% mutate(kin_index = 1:14))
-
-# check dimension: 128 years, 14 types of kin, 111 ages
-nrow(output_time_variant_df); 128*14*111
-
-# own calculation for first year
-out_first_year <- kin_time_invariant(
- U = U_hal[,"1891"],
- f = f_hal[,"1891"],
- pi = pi_hal[,"1891"],
- birth_female = 1)
-
-# check first visually demokin
-out_first_year %>%
- filter(alive == "yes") %>%
- group_by(age_focal, kin) %>%
- summarise(count = sum(count, na.rm=T)) %>%
- ggplot(aes(age_focal, count)) +
- geom_line() +
- facet_wrap(~kin, scales="free_y")
-
-# compare with paper results
-comparison <- out_first_year %>%
- filter(alive == "yes") %>%
- group_by(age_focal, kin) %>%
- summarise(count = sum(count, na.rm=T)) %>%
- mutate(source = "demokin") %>%
- bind_rows(
- output_time_variant_df %>%
- filter(year %in% 1891) %>%
- pivot_longer(`0`:`110`, names_to = "age", values_to = "count") %>%
- mutate(age = as.integer(age)) %>%
- group_by(age_focal=age, kin) %>%
- summarise(count = sum(count)) %>%
- mutate(source = "paper"))
-
-# comparison visually
-comparison %>%
- ggplot() +
- geom_line(aes(age_focal, count, color=source, linetype=source)) +
- facet_wrap(~kin, scales="free_y") +
- theme_bw()
diff --git a/dev/tests/timevarying_kin.m b/dev/tests/timevarying_kin.m
deleted file mode 100644
index c1176c8..0000000
--- a/dev/tests/timevarying_kin.m
+++ /dev/null
@@ -1,180 +0,0 @@
-function kout=timevarying_kin(U,F,pi,om,pkin);
-% function to return kinship network
-% calculated from the rates and the kinship at the previous time
-% U=survival matrix
-% F=fertility matrix
-% pi = distribution of ages of mothers
-% om=number of age classes
-% pkin = the array of all kin from the previous time step
-% model structure
-% k(x+1,t+1)=U(t)*k(x,t) + F(t)*kstar(x,t) for some other kin kstar
-
-%set to full in case they arrive as sparse matrices
-U=full(U);
-F=full(F);
-pi=full(pi);
-
-%frequently used zero vector for initial condition
-zvec=zeros(om,1);
-I=eye(om);
-omz=om-1;
-
-% a: daughters of focal
-
-A(:,1)=zvec;
-for ix=1:omz
- ap=U*pkin.A(:,ix) + F*I(:,ix);
- A(:,ix+1)=ap;
-
-end % for ix
-
-% b = granddaughters of Focal
-
-B(:,1)=zvec;
-for ix=1:omz
- bp=U*pkin.B(:,ix) + F*pkin.A(:,ix);
- B(:,ix+1)=bp;
-
-end
-
-
-% c = greatgranddaughters of Focal
-C(:,1)=zvec;
-for ix=1:omz
- cp=U*pkin.C(:,ix) +F*pkin.B(:,ix);
- C(:,ix+1)=cp;
-
-end
-
-
-% d = mothers of Focal
-D(:,1)=pi;
-for ix=1:omz
- dp=U*pkin.D(:,ix) + 0;
- D(:,ix+1)=dp;
-
-end
-
-
-% g = grandmothers of Focal
-%only maternal grandmothers right now
-G(:,1)=pkin.D*pi;;
-for ix=1:omz
- gp=U*pkin.G(:,ix) + 0;
- G(:,ix+1)=gp;
-
-end
-
-
-% h = greattrandmothers of Focal
-
-H(:,1)=pkin.G*pi;
-for ix=1:omz
- hp=U*pkin.H(:,ix) + 0;
- H(:,ix+1)=hp;
-
-end
-
-% m = older sisters of Focal
-
-M(:,1)=pkin.A*pi;
-for ix=1:omz
- mp=U*pkin.M(:,ix) + 0;
- M(:,ix+1)=mp;
-
-end
-
-% n = younger sisters
-
-N(:,1)=zvec;
-for ix=1:omz
- np=U*pkin.N(:,ix) + F*pkin.D(:,ix);
- N(:,ix+1)=np;
-
-end
-
-
-% p = nieces through older sisters
-
-P(:,1)=pkin.B*pi;
-for ix=1:omz
- pp=U*pkin.P(:,ix) + F*pkin.M(:,ix);
- P(:,ix+1)=pp;
-end
-
-% q = nieces through younger sisters
-
-Q(:,1)=zvec;
-for ix=1:omz
- qp=U*pkin.Q(:,ix) + F*pkin.N(:,ix);
- Q(:,ix+1)=qp;
-
-end
-
-% r = aunts older than mother
-
-R(:,1)=pkin.M*pi;
-for ix=1:omz
- rp=U*pkin.R(:,ix) + 0;
- R(:,ix+1)=rp;
-
-end
-
-% s = aunts younger than mother
-
-S(:,1)=pkin.N*pi;
-for ix=1:omz
- sp=U*pkin.S(:,ix) + F*pkin.G(:,ix);
- S(:,ix+1)=sp;
-
-end
-
-% t = cousins from older aunts
-
-T(:,1)=pkin.P*pi;
-for ix=1:omz
- tp=U*pkin.T(:,ix) + F*pkin.R(:,ix);
- T(:,ix+1)=tp;
-
-end
-
-
-% v = cousins from aunts younger than mother
-
-V(:,1)=pkin.Q*pi;
-for ix=1:omz
- vp=U*pkin.V(:,ix) + F*pkin.S(:,ix);
- V(:,ix+1)=vp;
-
-end
-
-%concatenate kin matrices
-allkin=cat(3,A,B,C,D,G,H,M,N,P,Q,R,S,T,V);
-
-%concatenate, combining older and younger sisters, etc.
-allkin2=cat(3,A,B,C,D,G,H,M+N,P+Q,R+S,T+V);
-
-%create output structures
-kout.A=A;
-kout.B=B;
-kout.C=C;
-kout.D=D;
-kout.G=G;
-kout.H=H;
-kout.M=M;
-kout.N=N;
-kout.P=P;
-kout.Q=Q;
-kout.R=R;
-kout.S=S;
-kout.T=T;
-kout.V=V;
-
-kout.allkin=allkin;
-kout.allkin2=allkin2;
-
-kout.U=U;
-kout.F=F;
-kout.pi=pi;
-
-
\ No newline at end of file
diff --git a/docs/404.html b/docs/404.html
new file mode 100644
index 0000000..7f90524
--- /dev/null
+++ b/docs/404.html
@@ -0,0 +1,133 @@
+
+
+
+
+
+
+
+Page not found (404) • DemoKin
+
+
+
+
+
+
+
+
+
+
+
+
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
+
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
+
THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Williams I, Alburez-Gutierrez D (2025).
+DemoKin: Estimate Population Kin Distribution.
+https://github.com/IvanWilli/DemoKin,
+https://ivanwilli.github.io/DemoKin/.
+
+
@Manual{,
+ title = {DemoKin: Estimate Population Kin Distribution},
+ author = {Iván Williams and Diego Alburez-Gutierrez},
+ year = {2025},
+ note = {https://github.com/IvanWilli/DemoKin,
+ https://ivanwilli.github.io/DemoKin/},
+}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/docs/bootstrap-toc.css b/docs/bootstrap-toc.css
new file mode 100644
index 0000000..5a85941
--- /dev/null
+++ b/docs/bootstrap-toc.css
@@ -0,0 +1,60 @@
+/*!
+ * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/)
+ * Copyright 2015 Aidan Feldman
+ * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */
+
+/* modified from https://github.com/twbs/bootstrap/blob/94b4076dd2efba9af71f0b18d4ee4b163aa9e0dd/docs/assets/css/src/docs.css#L548-L601 */
+
+/* All levels of nav */
+nav[data-toggle='toc'] .nav > li > a {
+ display: block;
+ padding: 4px 20px;
+ font-size: 13px;
+ font-weight: 500;
+ color: #767676;
+}
+nav[data-toggle='toc'] .nav > li > a:hover,
+nav[data-toggle='toc'] .nav > li > a:focus {
+ padding-left: 19px;
+ color: #563d7c;
+ text-decoration: none;
+ background-color: transparent;
+ border-left: 1px solid #563d7c;
+}
+nav[data-toggle='toc'] .nav > .active > a,
+nav[data-toggle='toc'] .nav > .active:hover > a,
+nav[data-toggle='toc'] .nav > .active:focus > a {
+ padding-left: 18px;
+ font-weight: bold;
+ color: #563d7c;
+ background-color: transparent;
+ border-left: 2px solid #563d7c;
+}
+
+/* Nav: second level (shown on .active) */
+nav[data-toggle='toc'] .nav .nav {
+ display: none; /* Hide by default, but at >768px, show it */
+ padding-bottom: 10px;
+}
+nav[data-toggle='toc'] .nav .nav > li > a {
+ padding-top: 1px;
+ padding-bottom: 1px;
+ padding-left: 30px;
+ font-size: 12px;
+ font-weight: normal;
+}
+nav[data-toggle='toc'] .nav .nav > li > a:hover,
+nav[data-toggle='toc'] .nav .nav > li > a:focus {
+ padding-left: 29px;
+}
+nav[data-toggle='toc'] .nav .nav > .active > a,
+nav[data-toggle='toc'] .nav .nav > .active:hover > a,
+nav[data-toggle='toc'] .nav .nav > .active:focus > a {
+ padding-left: 28px;
+ font-weight: 500;
+}
+
+/* from https://github.com/twbs/bootstrap/blob/e38f066d8c203c3e032da0ff23cd2d6098ee2dd6/docs/assets/css/src/docs.css#L631-L634 */
+nav[data-toggle='toc'] .nav > .active > ul {
+ display: block;
+}
diff --git a/docs/bootstrap-toc.js b/docs/bootstrap-toc.js
new file mode 100644
index 0000000..1cdd573
--- /dev/null
+++ b/docs/bootstrap-toc.js
@@ -0,0 +1,159 @@
+/*!
+ * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/)
+ * Copyright 2015 Aidan Feldman
+ * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */
+(function() {
+ 'use strict';
+
+ window.Toc = {
+ helpers: {
+ // return all matching elements in the set, or their descendants
+ findOrFilter: function($el, selector) {
+ // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/
+ // http://stackoverflow.com/a/12731439/358804
+ var $descendants = $el.find(selector);
+ return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])');
+ },
+
+ generateUniqueIdBase: function(el) {
+ var text = $(el).text();
+ var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-');
+ return anchor || el.tagName.toLowerCase();
+ },
+
+ generateUniqueId: function(el) {
+ var anchorBase = this.generateUniqueIdBase(el);
+ for (var i = 0; ; i++) {
+ var anchor = anchorBase;
+ if (i > 0) {
+ // add suffix
+ anchor += '-' + i;
+ }
+ // check if ID already exists
+ if (!document.getElementById(anchor)) {
+ return anchor;
+ }
+ }
+ },
+
+ generateAnchor: function(el) {
+ if (el.id) {
+ return el.id;
+ } else {
+ var anchor = this.generateUniqueId(el);
+ el.id = anchor;
+ return anchor;
+ }
+ },
+
+ createNavList: function() {
+ return $('
');
+ },
+
+ createChildNavList: function($parent) {
+ var $childList = this.createNavList();
+ $parent.append($childList);
+ return $childList;
+ },
+
+ generateNavEl: function(anchor, text) {
+ var $a = $('');
+ $a.attr('href', '#' + anchor);
+ $a.text(text);
+ var $li = $('');
+ $li.append($a);
+ return $li;
+ },
+
+ generateNavItem: function(headingEl) {
+ var anchor = this.generateAnchor(headingEl);
+ var $heading = $(headingEl);
+ var text = $heading.data('toc-text') || $heading.text();
+ return this.generateNavEl(anchor, text);
+ },
+
+ // Find the first heading level (`
`, then `
`, etc.) that has more than one element. Defaults to 1 (for `
DemoKin is an R package for the demographic analysis of kinship networks using matrix-based models.
+It implements methods developed by initially by Caswell (2019)), and continued in successive papers (like Caswell (2020)) for estimating the number and age distribution of relatives under various demographic assumptions.
+
+
+
+
Features
+
+
+
Estimate kin counts and age distributions for various types of relatives
+
Support for one-sex and two-sex models
+
Time-invariant and time-varying approaches
+
Multi-state models incorporating additional variables like parity or education
+
Visualization tools for kinship networks
+
+
+
+
Installation
+
+
You can install the development version of DemoKin from GitHub:
+
+# Run a one-sex time-invariant kinship model using Swedish data from 2015
+kin_results<-kin(
+ p =swe_px[,"2015"], # Survival probabilities
+ f =swe_asfr[,"2015"], # Fertility rates
+ time_invariant =TRUE# Use time-invariant model
+)
+
+# Visualize the expected number of living relatives by age
+kin_results$kin_summary%>%
+rename_kin()%>%
+ggplot2::ggplot(ggplot2::aes(age_focal, count_living))+
+ggplot2::geom_line()+
+ggplot2::facet_wrap(~kin_label, scales ="free_y")+
+ggplot2::labs(
+ title ="Expected number of living relatives by age",
+ x ="Age of focal individual",
+ y ="Number of relatives"
+)
+
+
+
Documentation
+
+
For detailed documentation, please visit the DemoKin website.
+
The site includes several vignettes demonstrating different types of kinship models:
Williams, Iván; Alburez-Gutierrez, Diego; and the DemoKin team. (2021) DemoKin: An R package to implement demographic matrix kinship models. URL: https://github.com/IvanWilli/DemoKin.
+
+
+
Acknowledgments
+
+
We thank Silvia Leek from the Max Planck Institute for Demographic Research for designing the DemoKin logo. The logo includes elements that have been taken or adapted from this file, originally by Ansunando, CC BY-SA 4.0 via Wikimedia Commons. Sha Jiang provided useful comments for improving the package.
+
+
+
Get involved!
+
+
DemoKin is under constant development. If you’re interested in contributing, please get in touch, create an issue, or submit a pull request. We look forward to hearing from you!
+
+
+
License
+
+
This project is licensed under the MIT License - see the LICENSE file for details.
if in dropdown
+ if (pos >= 0) {
+ var menu_anchor = $(links[pos]);
+ menu_anchor.parent().addClass("active");
+ menu_anchor.closest("li.dropdown").addClass("active");
+ }
+ });
+
+ function paths(pathname) {
+ var pieces = pathname.split("/");
+ pieces.shift(); // always starts with /
+
+ var end = pieces[pieces.length - 1];
+ if (end === "index.html" || end === "")
+ pieces.pop();
+ return(pieces);
+ }
+
+ // Returns -1 if not found
+ function prefix_length(needle, haystack) {
+ if (needle.length > haystack.length)
+ return(-1);
+
+ // Special case for length-0 haystack, since for loop won't run
+ if (haystack.length === 0) {
+ return(needle.length === 0 ? 0 : -1);
+ }
+
+ for (var i = 0; i < haystack.length; i++) {
+ if (needle[i] != haystack[i])
+ return(i);
+ }
+
+ return(haystack.length);
+ }
+
+ /* Clipboard --------------------------*/
+
+ function changeTooltipMessage(element, msg) {
+ var tooltipOriginalTitle=element.getAttribute('data-original-title');
+ element.setAttribute('data-original-title', msg);
+ $(element).tooltip('show');
+ element.setAttribute('data-original-title', tooltipOriginalTitle);
+ }
+
+ if(ClipboardJS.isSupported()) {
+ $(document).ready(function() {
+ var copyButton = "";
+
+ $("div.sourceCode").addClass("hasCopyButton");
+
+ // Insert copy buttons:
+ $(copyButton).prependTo(".hasCopyButton");
+
+ // Initialize tooltips:
+ $('.btn-copy-ex').tooltip({container: 'body'});
+
+ // Initialize clipboard:
+ var clipboardBtnCopies = new ClipboardJS('[data-clipboard-copy]', {
+ text: function(trigger) {
+ return trigger.parentNode.textContent.replace(/\n#>[^\n]*/g, "");
+ }
+ });
+
+ clipboardBtnCopies.on('success', function(e) {
+ changeTooltipMessage(e.trigger, 'Copied!');
+ e.clearSelection();
+ });
+
+ clipboardBtnCopies.on('error', function() {
+ changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy');
+ });
+ });
+ }
+})(window.jQuery || window.$)
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
new file mode 100644
index 0000000..5af90af
--- /dev/null
+++ b/docs/pkgdown.yml
@@ -0,0 +1,14 @@
+pandoc: 3.1.1
+pkgdown: 2.1.1.9000
+pkgdown_sha: 62d5c5a0fc12899aae97f6ce14018d2784bf308b
+articles:
+ 1_1_OneSex_TimeInvariant_Age: 1_1_OneSex_TimeInvariant_Age.html
+ 1_2_OneSex_TimeVarying_Age: 1_2_OneSex_TimeVarying_Age.html
+ 1_3_TwoSex_TimeInvariant_Age: 1_3_TwoSex_TimeInvariant_Age.html
+ 1_4_TwoSex_TimeVarying_Age: 1_4_TwoSex_TimeVarying_Age.html
+ 2_1_OneSex_TimeInvariant_AgeStage: 2_1_OneSex_TimeInvariant_AgeStage.html
+ 2_2_TwoSex_TimeVarying_AgeStage: 2_2_TwoSex_TimeVarying_AgeStage.html
+last_built: 2025-04-25T20:32Z
+urls:
+ reference: https://ivanwilli.github.io/DemoKin/reference
+ article: https://ivanwilli.github.io/DemoKin/articles
diff --git a/man/F_mat_fem_edu.Rd b/man/F_mat_fem_edu.Rd
new file mode 100644
index 0000000..73d840e
--- /dev/null
+++ b/man/F_mat_fem_edu.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{F_mat_fem_edu}
+\alias{F_mat_fem_edu}
+\title{Singapore: Lists of matrices containing fertility rates by age and education. Females}
+\format{
+The data is aggregated into 5-year age groups and 5-year time intervals
+}
+\source{
+Wittgenstein Center
+}
+\usage{
+F_mat_fem_edu
+}
+\description{
+Singapore: Lists of matrices containing fertility rates by age and education. Females
+}
+\keyword{datasets}
diff --git a/man/F_mat_male_edu.Rd b/man/F_mat_male_edu.Rd
new file mode 100644
index 0000000..88e10bb
--- /dev/null
+++ b/man/F_mat_male_edu.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{F_mat_male_edu}
+\alias{F_mat_male_edu}
+\title{Singapore: Lists of matrices containing fertility rates by age and education. Males}
+\format{
+The data is aggregated into 5-year age groups and 5-year time intervals
+}
+\source{
+Wittgenstein Center
+}
+\usage{
+F_mat_male_edu
+}
+\description{
+Singapore: Lists of matrices containing fertility rates by age and education. Males
+}
+\keyword{datasets}
diff --git a/man/Female_parity_fert_list_UK.Rd b/man/Female_parity_fert_list_UK.Rd
new file mode 100644
index 0000000..854be41
--- /dev/null
+++ b/man/Female_parity_fert_list_UK.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{Female_parity_fert_list_UK}
+\alias{Female_parity_fert_list_UK}
+\title{UK female fertility from 1965 to 2022}
+\format{
+list of age by stage matrices, entries give female fert. List starting 1965 ending 2022.
+}
+\source{
+HFD and ONS
+}
+\usage{
+Female_parity_fert_list_UK
+}
+\description{
+UK female fertility from 1965 to 2022
+}
+\keyword{datasets}
diff --git a/man/Female_parity_mortality_list_UK.Rd b/man/Female_parity_mortality_list_UK.Rd
new file mode 100644
index 0000000..3e0eef1
--- /dev/null
+++ b/man/Female_parity_mortality_list_UK.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{Female_parity_mortality_list_UK}
+\alias{Female_parity_mortality_list_UK}
+\title{UK female parity mortality from 1965 to 2022}
+\format{
+list of age by stage matrices, entries give female parity mortality List starting 1965 ending 2022.
+}
+\source{
+HFD and ONS
+}
+\usage{
+Female_parity_mortality_list_UK
+}
+\description{
+UK female parity mortality from 1965 to 2022
+}
+\keyword{datasets}
diff --git a/man/H_mat_edu.Rd b/man/H_mat_edu.Rd
new file mode 100644
index 0000000..f800037
--- /dev/null
+++ b/man/H_mat_edu.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{H_mat_edu}
+\alias{H_mat_edu}
+\title{Singapore: List of matrices that redistribute newborns to age-class 1 and "no education" category}
+\format{
+The data is aggregated into 5-year age groups and 5-year time intervals
+}
+\source{
+Wittgenstein Center
+}
+\usage{
+H_mat_edu
+}
+\description{
+Singapore: List of matrices that redistribute newborns to age-class 1 and "no education" category
+}
+\keyword{datasets}
diff --git a/man/Male_parity_mortality_list_UK.Rd b/man/Male_parity_mortality_list_UK.Rd
new file mode 100644
index 0000000..316ca71
--- /dev/null
+++ b/man/Male_parity_mortality_list_UK.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{Male_parity_mortality_list_UK}
+\alias{Male_parity_mortality_list_UK}
+\title{UK male parity mortality from 1965 to 2022}
+\format{
+list of age by stage matrices, entries give male parity mortality List starting 1965 ending 2022.
+}
+\source{
+HFD and ONS
+}
+\usage{
+Male_parity_mortality_list_UK
+}
+\description{
+UK male parity mortality from 1965 to 2022
+}
+\keyword{datasets}
diff --git a/man/Parity_transfers_by_age_list_UK.Rd b/man/Parity_transfers_by_age_list_UK.Rd
new file mode 100644
index 0000000..babf3e9
--- /dev/null
+++ b/man/Parity_transfers_by_age_list_UK.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{Parity_transfers_by_age_list_UK}
+\alias{Parity_transfers_by_age_list_UK}
+\title{UK female parity transitions from 1965 to 2022}
+\format{
+list of age by stage matrices, entries give female parity transitions. List starting 1965 ending 2022.
+}
+\source{
+HFD and ONS
+}
+\usage{
+Parity_transfers_by_age_list_UK
+}
+\description{
+UK female parity transitions from 1965 to 2022
+}
+\keyword{datasets}
diff --git a/man/Redistribution_by_parity_list_UK.Rd b/man/Redistribution_by_parity_list_UK.Rd
new file mode 100644
index 0000000..2d81919
--- /dev/null
+++ b/man/Redistribution_by_parity_list_UK.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{Redistribution_by_parity_list_UK}
+\alias{Redistribution_by_parity_list_UK}
+\title{UK parity assign parity at birth}
+\format{
+list of matrices which redistributes newborns to age-class 1 and parity 0. No time-variation.
+}
+\source{
+None
+}
+\usage{
+Redistribution_by_parity_list_UK
+}
+\description{
+UK parity assign parity at birth
+}
+\keyword{datasets}
diff --git a/man/T_mat_fem_edu.Rd b/man/T_mat_fem_edu.Rd
new file mode 100644
index 0000000..8209920
--- /dev/null
+++ b/man/T_mat_fem_edu.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{T_mat_fem_edu}
+\alias{T_mat_fem_edu}
+\title{Singapore: Lists of transition matrices showing probabilities of moving between education states. Females}
+\format{
+The data is aggregated into 5-year age groups and 5-year time intervals
+}
+\source{
+Wittgenstein Center
+}
+\usage{
+T_mat_fem_edu
+}
+\description{
+Singapore: Lists of transition matrices showing probabilities of moving between education states. Females
+}
+\keyword{datasets}
diff --git a/man/T_mat_male_edu.Rd b/man/T_mat_male_edu.Rd
new file mode 100644
index 0000000..0bab26d
--- /dev/null
+++ b/man/T_mat_male_edu.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{T_mat_male_edu}
+\alias{T_mat_male_edu}
+\title{Singapore: Lists of transition matrices showing probabilities of moving between education states. Males}
+\format{
+The data is aggregated into 5-year age groups and 5-year time intervals
+}
+\source{
+Wittgenstein Center
+}
+\usage{
+T_mat_male_edu
+}
+\description{
+Singapore: Lists of transition matrices showing probabilities of moving between education states. Males
+}
+\keyword{datasets}
diff --git a/man/U_mat_fem_edu.Rd b/man/U_mat_fem_edu.Rd
new file mode 100644
index 0000000..f1a6255
--- /dev/null
+++ b/man/U_mat_fem_edu.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{U_mat_fem_edu}
+\alias{U_mat_fem_edu}
+\title{Singapore: Lists of matrices containing survival probabilities by age (rows) and education (columns) from 2020-2090. Females}
+\format{
+The data is aggregated into 5-year age groups and 5-year time intervals
+}
+\source{
+Wittgenstein Center
+}
+\usage{
+U_mat_fem_edu
+}
+\description{
+Singapore: Lists of matrices containing survival probabilities by age (rows) and education (columns) from 2020-2090. Females
+}
+\keyword{datasets}
diff --git a/man/U_mat_male_edu.Rd b/man/U_mat_male_edu.Rd
new file mode 100644
index 0000000..e67777b
--- /dev/null
+++ b/man/U_mat_male_edu.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{U_mat_male_edu}
+\alias{U_mat_male_edu}
+\title{Singapore: Lists of matrices containing survival probabilities by age (rows) and education (columns) from 2020-2090. Males}
+\format{
+The data is aggregated into 5-year age groups and 5-year time intervals
+}
+\source{
+Wittgenstein Center
+}
+\usage{
+U_mat_male_edu
+}
+\description{
+Singapore: Lists of matrices containing survival probabilities by age (rows) and education (columns) from 2020-2090. Males
+}
+\keyword{datasets}
diff --git a/man/all_kin_dy.Rd b/man/all_kin_dy.Rd
new file mode 100644
index 0000000..261be62
--- /dev/null
+++ b/man/all_kin_dy.Rd
@@ -0,0 +1,48 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_multi_stage_time_variant_2sex.R
+\name{all_kin_dy}
+\alias{all_kin_dy}
+\title{Title time invariant two-sex multi-state kin projections}
+\usage{
+all_kin_dy(
+ Uf,
+ Um,
+ Ff,
+ Fm,
+ alpha,
+ na,
+ ns,
+ Parity,
+ sex_Focal,
+ Initial_stage_Focal
+)
+}
+\arguments{
+\item{Uf}{matrix (block structured). transfers female individuals across stages and advances their age (conditional on survial)}
+
+\item{Um}{matrix (block structured). transfers male individuals across stages and advances their age (conditional on survial)}
+
+\item{Ff}{matrix (block structured). accounts for female reproduction, and assigns newborns into given age*stage}
+
+\item{Fm}{matrix (block structured). accounts for male reproduction; assigns newborns into age-class, and stage}
+
+\item{alpha}{scalar. birth ratio (male:female)}
+
+\item{na}{scalar. number of ages.}
+
+\item{ns}{scalar. number of stages.}
+
+\item{Parity}{logical. If true then we omit mothers of parity 0, and re-scale the mother's age*stage of parenting}
+
+\item{sex_Focal}{logical. Female or Male}
+
+\item{Initial_stage_Focal}{numeric. Any natural number {1,2,3,4,...}}
+}
+\value{
+a list of matrices. Each list entry represents a particular kin. Each kin is chacacterised by a matrix of dimension:
+nrow = 2* na * ns (2-sex age-stage structured) and ncol = na (Focal's age)
+yielding the age*stage distribution of kin for each age of Focal
+}
+\description{
+Title time invariant two-sex multi-state kin projections
+}
diff --git a/man/all_kin_dy_TV.Rd b/man/all_kin_dy_TV.Rd
new file mode 100644
index 0000000..c390385
--- /dev/null
+++ b/man/all_kin_dy_TV.Rd
@@ -0,0 +1,94 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_multi_stage_time_variant_2sex.R
+\name{all_kin_dy_TV}
+\alias{all_kin_dy_TV}
+\title{Title time-variant two-sex multi-state kin projections}
+\usage{
+all_kin_dy_TV(
+ Uf,
+ Um,
+ Ff,
+ Fm,
+ alpha,
+ na,
+ ns,
+ Parity,
+ sex_Focal,
+ Initial_stage_Focal,
+ previous_kin_Focal,
+ prev_kin_children,
+ prev_kin_grandchildren,
+ prev_kin_greatgrandchildren,
+ prev_kin_parents,
+ prev_kin_grand_parents,
+ prev_kin_great_grand_parents,
+ prev_kin_older_sibs,
+ prev_kin_younger_sibs,
+ prev_kin_older_niece_nephew,
+ prev_kin_younger_niece_nephew,
+ prev_kin_older_aunts_uncles,
+ prev_kin_younger_aunts_uncles,
+ prev_kin_older_cousins,
+ prev_kin_younger_cousins,
+ previous_population_age_stage_structure
+)
+}
+\arguments{
+\item{Uf}{matrix (block structured). transfers female individuals across stages and advances their age (conditional on survial)}
+
+\item{Um}{matrix (block structured). transfers male individuals across stages and advances their age (conditional on survial)}
+
+\item{Ff}{matrix (block structured). accounts for female reproduction, and assigns newborns into given age*stage}
+
+\item{Fm}{matrix (block structured). accounts for male reproduction; assigns newborns into age-class, and stage}
+
+\item{alpha}{scalar. birth ratio (male:female)}
+
+\item{na}{scalar. number of ages.}
+
+\item{ns}{scalar. number of stages.}
+
+\item{Parity}{logical. If true then we omit mothers of parity 0, and re-scale the mother's age*stage of parenting}
+
+\item{sex_Focal}{logical. Female or Male}
+
+\item{Initial_stage_Focal}{numeric. Any natural number {1,2,3,4,...}}
+
+\item{previous_kin_Focal}{matrix. last years kinship output.}
+
+\item{prev_kin_children}{matrix. last years kinship output.}
+
+\item{prev_kin_grandchildren}{matrix. last years kinship output.}
+
+\item{prev_kin_greatgrandchildren}{matrix. last years kinship output.}
+
+\item{prev_kin_parents}{matrix. last years kinship output.}
+
+\item{prev_kin_grand_parents}{matrix. last years kinship output.}
+
+\item{prev_kin_older_sibs}{matrix. last years kinship output.}
+
+\item{prev_kin_younger_sibs}{matrix. last years kinship output.}
+
+\item{prev_kin_older_niece_nephew}{matrix. last years kinship output.}
+
+\item{prev_kin_younger_niece_nephew}{matrix. last years kinship output.}
+
+\item{prev_kin_older_aunts_uncles}{matrix. last years kinship output.}
+
+\item{prev_kin_younger_aunts_uncles}{matrix. last years kinship output.}
+
+\item{prev_kin_older_cousins}{matrix. last years kinship output.}
+
+\item{prev_kin_younger_cousins}{matrix. last years kinship output.}
+
+\item{previous_population_age_stage_structure}{vector. The transient "population structure" (age*stage distributed)}
+}
+\value{
+a list of matrices. Each list entry represents a particular kin. Each kin is chacacterised by a matrix of dimension:
+nrow = 2* na * ns (2-sex age-stage structured) and ncol = na (Focal's age)
+yielding the age*stage distribution of kin for each age of Focal
+}
+\description{
+Title time-variant two-sex multi-state kin projections
+}
diff --git a/man/create_cumsum_df.Rd b/man/create_cumsum_df.Rd
new file mode 100644
index 0000000..920d482
--- /dev/null
+++ b/man/create_cumsum_df.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_multi_stage_time_variant_2sex.R
+\name{create_cumsum_df}
+\alias{create_cumsum_df}
+\title{Title Accumulated kin by each age of Focal, for each time period, and cohort of birth}
+\usage{
+create_cumsum_df(
+ kin_matrix_lists,
+ kin_names,
+ years,
+ start_year,
+ na,
+ ns,
+ specific_kin = NULL
+)
+}
+\arguments{
+\item{kin_matrix_lists}{list of lists of kin matrices: list( list(X_focal), list(X_parents), ... ). Outer list is length 14 = number of kin. Inner lists have lenght = timescale
+so list(X_focal) = list(X_focal\link{year1},X_focal\link{year2},...,X_focal\link{yearlast})}
+
+\item{kin_names}{list of characters. Corresponding to above lists: list("F","m",....)}
+
+\item{years}{vector. The timescale on which we implement the kinship model.}
+
+\item{start_year}{. First year of varying vital rates (e.g., if years = 1990:2000 then start_year = 1990)}
+
+\item{na}{numeric. Number of ages.}
+
+\item{ns}{numeric. Number of stages.}
+
+\item{specific_kin}{character. names of kin we wish to analyse, e.g., list("os","ys"). If null returns all 14.}
+}
+\value{
+A data frame which gives for each age of Focal at each year in the timescale, Focal's experienced number kin demarcated by stages (summed over all ages)
+}
+\description{
+Title Accumulated kin by each age of Focal, for each time period, and cohort of birth
+}
diff --git a/man/create_full_dists_df.Rd b/man/create_full_dists_df.Rd
new file mode 100644
index 0000000..2e4e0c8
--- /dev/null
+++ b/man/create_full_dists_df.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_multi_stage_time_variant_2sex.R
+\name{create_full_dists_df}
+\alias{create_full_dists_df}
+\title{Title joint age*stage distributions of kin by each age of Focal, for each time period, and cohort of birth}
+\usage{
+create_full_dists_df(
+ kin_matrix_lists,
+ kin_names,
+ years,
+ start_year,
+ na,
+ ns,
+ specific_kin = NULL
+)
+}
+\arguments{
+\item{kin_matrix_lists}{list of lists of kin matrices: list( list(X_focal), list(X_parents), ... ). Outer list is length 14 = number of kin. Inner lists have lenght = timescale
+so list(X_focal) = list(X_focal\link{year1},X_focal\link{year2},...,X_focal\link{yearlast})}
+
+\item{kin_names}{list of characters. Corresponding to above lists: list("F","m",....)}
+
+\item{years}{vector. The timescale on which we implement the kinship model.}
+
+\item{start_year}{. First year of varying vital rates (e.g., if years = 1990:2000 then start_year = 1990)}
+
+\item{na}{numeric. Number of ages.}
+
+\item{ns}{numeric. Number of stages.}
+
+\item{specific_kin}{character. names of kin we wish to analyse, e.g., list("os","ys"). If null returns all 14.}
+}
+\value{
+A data frame which gives for each age of Focal at each year in the timescale, the full age*stage dist of kin
+}
+\description{
+Title joint age*stage distributions of kin by each age of Focal, for each time period, and cohort of birth
+}
diff --git a/man/demokin_codes.Rd b/man/demokin_codes.Rd
index deb1b04..6f1e241 100644
--- a/man/demokin_codes.Rd
+++ b/man/demokin_codes.Rd
@@ -1,11 +1,16 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/aux_funs.R
+% Please edit documentation in R/data.R
+\docType{data}
\name{demokin_codes}
\alias{demokin_codes}
-\title{print kin codes}
+\title{DemoKin codes, Caswell (2020) codes, and useful labels.}
+\format{
+A data.frame with codes and labels for distinction between kin types.
+}
\usage{
-demokin_codes()
+demokin_codes
}
\description{
-Print kin codes and labels
+DemoKin codes, Caswell (2020) codes, and useful labels.
}
+\keyword{datasets}
diff --git a/DemoKin-Logo.png b/man/figures/DemoKin-Logo.png
similarity index 100%
rename from DemoKin-Logo.png
rename to man/figures/DemoKin-Logo.png
diff --git a/man/figures/README-unnamed-chunk-3-1.png b/man/figures/README-unnamed-chunk-3-1.png
new file mode 100644
index 0000000..1be1a7d
Binary files /dev/null and b/man/figures/README-unnamed-chunk-3-1.png differ
diff --git a/man/figures/README-unnamed-chunk-3-1.svg b/man/figures/README-unnamed-chunk-3-1.svg
new file mode 100644
index 0000000..58a0d6c
--- /dev/null
+++ b/man/figures/README-unnamed-chunk-3-1.svg
@@ -0,0 +1,2854 @@
+
+
diff --git a/man/figures/README-unnamed-chunk-4-1.png b/man/figures/README-unnamed-chunk-4-1.png
index 118cd3c..681db7c 100644
Binary files a/man/figures/README-unnamed-chunk-4-1.png and b/man/figures/README-unnamed-chunk-4-1.png differ
diff --git a/man/figures/README-unnamed-chunk-5-1.png b/man/figures/README-unnamed-chunk-5-1.png
index 118cd3c..681db7c 100644
Binary files a/man/figures/README-unnamed-chunk-5-1.png and b/man/figures/README-unnamed-chunk-5-1.png differ
diff --git a/man/fra_asfr_sex.Rd b/man/fra_asfr_sex.Rd
new file mode 100644
index 0000000..dfda668
--- /dev/null
+++ b/man/fra_asfr_sex.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{fra_asfr_sex}
+\alias{fra_asfr_sex}
+\title{Fertility for France (2012) by sex in Caswell (2022).}
+\format{
+A data.frame with age specific fertility rates by age and sex.
+}
+\source{
+Caswell (2022)
+}
+\usage{
+fra_asfr_sex
+}
+\description{
+Fertility for France (2012) by sex in Caswell (2022).
+}
+\keyword{datasets}
diff --git a/man/fra_surv_sex.Rd b/man/fra_surv_sex.Rd
new file mode 100644
index 0000000..afa550f
--- /dev/null
+++ b/man/fra_surv_sex.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{fra_surv_sex}
+\alias{fra_surv_sex}
+\title{Survival probability for France (2012) by sex in Caswell (2022).}
+\format{
+A data.frame with survival probabilities by age and sex.
+}
+\source{
+Caswell (2022)
+}
+\usage{
+fra_surv_sex
+}
+\description{
+Survival probability for France (2012) by sex in Caswell (2022).
+}
+\keyword{datasets}
diff --git a/man/get_HMDHFD.Rd b/man/get_HMDHFD.Rd
deleted file mode 100644
index 9bbf264..0000000
--- a/man/get_HMDHFD.Rd
+++ /dev/null
@@ -1,41 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/get_HMDHFD.R
-\name{get_HMDHFD}
-\alias{get_HMDHFD}
-\title{Get time serie matrix data from HMD/HFD}
-\usage{
-get_HMDHFD(
- country = "SWE",
- min_year = 1900,
- max_year = 2018,
- user_HMD = NULL,
- pass_HMD = NULL,
- user_HFD = NULL,
- pass_HFD = NULL,
- OAG = 100
-)
-}
-\arguments{
-\item{country}{numeric. Country code from rom HMD/HFD.}
-
-\item{min_year}{integer. Older year to get data.}
-
-\item{max_year}{numeric. Latest year to get data.}
-
-\item{user_HMD}{character. From HMD.}
-
-\item{pass_HMD}{character. From HMD.}
-
-\item{user_HFD}{character. From HFD.}
-
-\item{pass_HFD}{character. From HFD.}
-
-\item{OAG}{numeric. Open age group to standarize output.}
-}
-\value{
-A list wiith female survival probability, survival function, fertility and poopulation age specific matrixes, with calendar year as colnames.
-}
-\description{
-Wrapper function to get data of female survival, fertlity and population
-of selected country on selected period.
-}
diff --git a/man/kin.Rd b/man/kin.Rd
index 21c8115..5fbc92f 100644
--- a/man/kin.Rd
+++ b/man/kin.Rd
@@ -2,31 +2,33 @@
% Please edit documentation in R/kin.R
\name{kin}
\alias{kin}
-\title{Estimate kin counts}
+\title{Estimate kin counts in a one-sex framework.}
\usage{
kin(
- U = NULL,
+ p = NULL,
f = NULL,
time_invariant = TRUE,
- N = NULL,
pi = NULL,
+ n = NULL,
output_cohort = NULL,
output_period = NULL,
output_kin = NULL,
+ output_age_focal = NULL,
birth_female = 1/2.04,
- stable = lifecycle::deprecated()
+ summary_kin = TRUE
)
}
\arguments{
-\item{U}{numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).}
+\item{p}{numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class
+in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).}
-\item{f}{numeric. Same as U but for fertility rates.}
+\item{f}{numeric. Same as \code{p} but for fertility rates.}
\item{time_invariant}{logical. Constant assumption for a given \code{year} rates. Default \code{TRUE}.}
-\item{N}{numeric. Same as U but for population distribution (counts or \verb{\%}). Optional.}
+\item{pi}{numeric. Same as \code{U} but for childbearing distribution (sum to 1). Optional.}
-\item{pi}{numeric. Same as U but for childbearing distribution (sum to 1). Optional.}
+\item{n}{numeric. Only for \code{time_invariant = FALSE}. Same as \code{p} but for population distribution (counts or \verb{\%}). Optional.}
\item{output_cohort}{integer. Vector of year cohorts for returning results. Should be within input data years range.}
@@ -34,13 +36,20 @@ kin(
\item{output_kin}{character. kin types to return: "m" for mother, "d" for daughter,...}
-\item{birth_female}{numeric. Female portion at birth. This multiplies \code{f} argument. If \code{f} is already for female offspring, this needs to be set as 1.}
+\item{output_age_focal}{integer. Vector of ages to select (and make faster the run).}
+
+\item{birth_female}{numeric. Female portion at birth. This multiplies \code{f} argument. If \code{f} is already for female offspring,}
+
+\item{summary_kin}{logical. Whether or not include \code{kin_summary} table (see output details). Default \code{TRUE}.
+this needs to be set as 1.}
}
\value{
A list with:
\itemize{
-\item{kin_full}{ a data frame with year, cohort, Focal´s age, related ages and type of kin (for example \code{d} is daughter, \code{oa} is older aunts, etc.), including living and dead kin at that age.}
-\item{kin_summary}{ a data frame with Focal´s age, related ages and type of kin, with indicators obtained processing \code{kin_full}, grouping by cohort or period (depending on the given arguments):}
+\item{kin_full}{ a data frame with year, cohort, Focal´s age, related ages and type of kin (for example \code{d} is daughter,
+\code{oa} is older aunts, etc.), including living and dead kin at that age.}
+\item{kin_summary}{ a data frame with Focal´s age, related ages and type of kin, with indicators obtained processing \code{kin_full},
+grouping by cohort or period (depending on the given arguments):}
{\itemize{
\item{\code{count_living}}{: count of living kin at actual age of Focal}
\item{\code{mean_age}}{: mean age of each type of living kin.}
@@ -53,8 +62,17 @@ A list with:
}
}
\description{
-Implementation of Goodman-Keyfitz-Pullum equations in a matrix framework.
+Implementation of Goodman-Keyfitz-Pullum equations in a matrix framework. This produce a matrilineal (or patrilineal)
+kin count distribution by kin and age.
}
\details{
See Caswell (2019) and Caswell (2021) for details on formulas. One sex only (female by default).
}
+\examples{
+# Kin expected matrilineal count for a Swedish female based on 2015 rates.
+swe_surv_2015 <- swe_px[,"2015"]
+swe_asfr_2015 <- swe_asfr[,"2015"]
+# Run kinship models
+swe_2015 <- kin(p = swe_surv_2015, f = swe_asfr_2015)
+head(swe_2015$kin_summary)
+}
diff --git a/man/kin2sex.Rd b/man/kin2sex.Rd
new file mode 100644
index 0000000..fde5cd9
--- /dev/null
+++ b/man/kin2sex.Rd
@@ -0,0 +1,100 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin2sex.R
+\name{kin2sex}
+\alias{kin2sex}
+\title{Estimate kin counts in a two-sex framework}
+\usage{
+kin2sex(
+ pf = NULL,
+ pm = NULL,
+ ff = NULL,
+ fm = NULL,
+ time_invariant = TRUE,
+ sex_focal = "f",
+ birth_female = 1/2.04,
+ pif = NULL,
+ pim = NULL,
+ nf = NULL,
+ nm = NULL,
+ Hf = NULL,
+ Hm = NULL,
+ output_cohort = NULL,
+ output_period = NULL,
+ output_kin = NULL,
+ output_age_focal = NULL,
+ summary_kin = TRUE
+)
+}
+\arguments{
+\item{pf}{numeric. A vector (atomic) or matrix with female probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).}
+
+\item{pm}{numeric. A vector (atomic) or matrix with male probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).}
+
+\item{ff}{numeric. Same as \code{pf} but for fertility rates.}
+
+\item{fm}{numeric. Same as \code{pm} but for fertility rates.}
+
+\item{time_invariant}{logical. Constant assumption for a given \code{year} rates. Default \code{TRUE}.}
+
+\item{sex_focal}{character. "f" for female or "m" for male.}
+
+\item{birth_female}{numeric. Female portion at birth. This multiplies \code{f} argument. If \code{f} is already for female offspring, this needs to be set as 1.}
+
+\item{pif}{numeric. For using some specific age distribution of childbearing for mothers (same length as ages). Default \code{NULL}.}
+
+\item{pim}{numeric. For using some specific age distribution of childbearing for fathers (same length as ages). Default \code{NULL}.}
+
+\item{nf}{numeric. Only for \code{time_invariant = FALSE}. Same as \code{pf} but for population distribution (counts or \verb{\%}). Optional.}
+
+\item{nm}{numeric. Only for \code{time_invariant = FALSE}. Same as \code{pm} but for population distribution (counts or \verb{\%}). Optional.}
+
+\item{Hf}{numeric. A list where each list element (being the name of each list element the year) contains a matrix with cause-specific hazards for females with rows as causes and columns as ages, being the name of each col the age.}
+
+\item{Hm}{numeric. A list where each list element (being the name of each list element the year) contains a matrix with cause-specific hazards for males with rows as causes and columns as ages, being the name of each col the age.}
+
+\item{output_cohort}{integer. Vector of year cohorts for returning results. Should be within input data years range.}
+
+\item{output_period}{integer. Vector of period years for returning results. Should be within input data years range.}
+
+\item{output_kin}{character. kin types to return: "m" for mother, "d" for daughter,...}
+
+\item{output_age_focal}{integer. Vector of ages to select (and make faster the run).}
+
+\item{summary_kin}{logical. Whether or not include \code{kin_summary} table (see output details). Default \code{TRUE}.}
+}
+\value{
+A list with:
+\itemize{
+\item{kin_full}{ a data frame with year, cohort, Focal´s age, related ages and type of kin (for example \code{d} could be daughter or son depending \code{sex_kin},
+\code{oa} is older aunts or uncles also depending \code{sex_kin} value, etc.), including living and dead kin at that age.}
+\item{kin_summary}{ a data frame with Focal´s age, related ages, sex and type of kin, with indicators obtained processing \code{kin_full}, grouping by cohort or period (depending on the given arguments):}
+{\itemize{
+\item{\code{count_living}}{: count of living kin at actual age of Focal}
+\item{\code{mean_age}}{: mean age of each type of living kin.}
+\item{\code{sd_age}}{: standard deviation of age of each type of living kin.}
+\item{\code{count_death}}{: count of dead kin at specific age of Focal.}
+\item{\code{count_cum_death}}{: cumulated count of dead kin until specific age of Focal.}
+\item{\code{mean_age_lost}}{: mean age where Focal lost her relative.}
+}
+}
+}
+}
+\description{
+Implementation of two-sex matrix kinship model. This produces kin counts grouped by kin, age and sex of
+each relatives at each Focal´s age. For example, male cousins from aunts and uncles from different sibling's parents
+are grouped in one male count of cousins. Note that the output labels relative following female notation: the label \code{m}
+refers to either mothers or fathers, and column \code{sex_kin} determine the sex of the relative.
+}
+\details{
+See Caswell (2022) for details on formulas.
+}
+\examples{
+# Kin expected count by relative sex for a French female based on 2012 rates.
+fra_fert_f <- fra_asfr_sex[,"ff"]
+fra_fert_m <- fra_asfr_sex[,"fm"]
+fra_surv_f <- fra_surv_sex[,"pf"]
+fra_surv_m <- fra_surv_sex[,"pm"]
+fra_2012 <- kin2sex(fra_surv_f, fra_surv_m, fra_fert_f, fra_fert_m)
+head(fra_2012$kin_summary)
+
+}
diff --git a/man/kin_multi_stage.Rd b/man/kin_multi_stage.Rd
index 12fa213..7a0830d 100644
--- a/man/kin_multi_stage.Rd
+++ b/man/kin_multi_stage.Rd
@@ -11,22 +11,25 @@ kin_multi_stage(
H = NULL,
birth_female = 1/2.04,
output_kin = NULL,
+ parity = FALSE,
list_output = FALSE
)
}
\arguments{
-\item{U}{list. age elemnts with column-stochastic transition matrix with dimension for the state space, conditional on survival.}
+\item{U}{list. age elements with column-stochastic transition matrix with dimension for the state space, conditional on survival.}
-\item{f}{matrix. state-specific fertility (age in rows and states in columns).}
+\item{f}{matrix. state-specific fertility (age in rows and states in columns). Is accepted also a list with for each age-class.}
-\item{D}{matrix. survival probabilities by state (age in rows and states in columns)}
+\item{D}{matrix. survival probabilities by state (age in rows and states in columns). Is accepted also a list for each state with survival matrices.}
-\item{H}{matrix. assigns the offspring of individuals in some stage to the appropriate age class with 1 (age in rows and states in columns).}
+\item{H}{matrix. assigns the offspring of individuals in some stage to the appropriate age class (age in rows and states in columns). Is accepted also a list with a matrix for each state.}
\item{birth_female}{numeric. Female portion at birth.}
\item{output_kin}{character. kin to return. For example "m" for mother, "d" for daughter. See the \code{vignette} for all kin types.}
+\item{parity}{logical. parity states imply age distribution of mothers re-scaled to not have parity 0 when Focal born. Default \code{TRUE}.}
+
\item{list_output}{logical. Results as a list. Default \code{FALSE}.}
}
\value{
diff --git a/man/kin_multi_stage_time_variant_2sex.Rd b/man/kin_multi_stage_time_variant_2sex.Rd
new file mode 100644
index 0000000..e62d30f
--- /dev/null
+++ b/man/kin_multi_stage_time_variant_2sex.Rd
@@ -0,0 +1,60 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_multi_stage_time_variant_2sex.R
+\name{kin_multi_stage_time_variant_2sex}
+\alias{kin_multi_stage_time_variant_2sex}
+\title{Estimate kin counts by age, stage, and sex, in a time variant framework}
+\usage{
+kin_multi_stage_time_variant_2sex(
+ U_list_females = NULL,
+ U_list_males = NULL,
+ F_list_females = NULL,
+ F_list_males = NULL,
+ T_list_females = NULL,
+ T_list_males = NULL,
+ H_list = NULL,
+ birth_female = 0.49,
+ parity = FALSE,
+ output_kin = NULL,
+ summary_kin = TRUE,
+ sex_Focal = "Female",
+ initial_stage_Focal = NULL,
+ output_years
+)
+}
+\arguments{
+\item{U_list_females}{list with matrix entries: period-specific female survival probabilities. Age in rows and states in columns.}
+
+\item{U_list_males}{list with matrix entries: period-specific male survival probabilities. Age in rows and states in columns.}
+
+\item{F_list_females}{list with matrix with elements: period-specific female fertility (age in rows and states in columns).}
+
+\item{F_list_males}{list with matrix entries: period-specific male fertility (age in rows and states in columns).}
+
+\item{T_list_females}{list of lists with matrix entries: each outer list entry is period-specific, and composed of
+a list of stochastic matrices which describe age-specific female probabilities of transferring stage}
+
+\item{T_list_males}{list of lists with matrix entries: each outer list entry is period-specific, and composed of
+a list of stochastic matrices which describe age-specific male probabilities of transferring stage}
+
+\item{H_list}{list with matrix entries: redistribution of newborns across each stage to a specific age-class}
+
+\item{birth_female}{numeric. birth ratio of females to males in population}
+
+\item{parity}{logical. parity states imply age distribution of mothers re-scaled to not have parity 0 when Focal born. Default \code{TRUE}.}
+
+\item{output_kin}{vector. A vector of particular kin one wishes to obtain results for, e.g., c("m","d","oa"). Default is all kin types.}
+
+\item{summary_kin}{logical. Results as a data frame of accumulated kin by age of Focal if TRUE, and kin by their age*stage distribution by age of Focal if FALSE.}
+
+\item{sex_Focal}{character. Female or Male as the user requests.}
+
+\item{initial_stage_Focal}{Numeric in Natural number set {1,2,...,}. The stage which Focal is born into (e.g., 1 for parity 0)}
+
+\item{output_years}{vector. The times at which we wish to count kin: start year = output_years\link{1}, and end year = output_years\link{length.}}
+}
+\value{
+A data frame with focal age, kin age, kin stage, kin sex, year, cohort, and expected number of kin given these restrictions.
+}
+\description{
+Implementation of combined formal demographic models: Caswell II,III,IV.
+}
diff --git a/man/kin_time_invariant.Rd b/man/kin_time_invariant.Rd
index a470503..d04e243 100644
--- a/man/kin_time_invariant.Rd
+++ b/man/kin_time_invariant.Rd
@@ -2,10 +2,10 @@
% Please edit documentation in R/kin_time_invariant.R
\name{kin_time_invariant}
\alias{kin_time_invariant}
-\title{Estimate kin counts in a time invariant framework}
+\title{Estimate kin counts in a time invariant framework for one-sex model (matrilineal/patrilineal)}
\usage{
kin_time_invariant(
- U = NULL,
+ p = NULL,
f = NULL,
birth_female = 1/2.04,
pi = NULL,
@@ -14,7 +14,7 @@ kin_time_invariant(
)
}
\arguments{
-\item{U}{numeric. A vector of survival probabilities with same length as ages.}
+\item{p}{numeric. A vector of survival probabilities with same length as ages.}
\item{f}{numeric. A vector of age-specific fertility rates with same length as ages.}
@@ -22,7 +22,7 @@ kin_time_invariant(
\item{pi}{numeric. For using some specific non-stable age distribution of childbearing (same length as ages). Default \code{NULL}.}
-\item{output_kin}{character. kin to return. For example "m" for mother, "d" for daughter. See the \code{vignette} for all kin types.}
+\item{output_kin}{character. kin to return. For example "m" for mother, "d" for daughter. See \code{vignette} for all kin types.}
\item{list_output}{logical. Results as a list with \code{output_kin} elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default \code{FALSE}}
}
@@ -31,5 +31,5 @@ A data frame with focal´s age, related ages and type of kin
(for example \code{d} is daughter, \code{oa} is older aunts, etc.), alive and death. If \code{list_output = TRUE} then this is a list.
}
\description{
-Implementation of Goodman-Keyfitz-Pullum equations adapted by Caswell (2019).
+Mtrix implementation of Goodman-Keyfitz-Pullum equations adapted by Caswell (2019).
}
diff --git a/man/kin_time_invariant_2sex.Rd b/man/kin_time_invariant_2sex.Rd
new file mode 100644
index 0000000..550a331
--- /dev/null
+++ b/man/kin_time_invariant_2sex.Rd
@@ -0,0 +1,52 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_time_invariant_2sex.R
+\name{kin_time_invariant_2sex}
+\alias{kin_time_invariant_2sex}
+\title{Estimate kin counts in a time invariant framework for two-sex model.}
+\usage{
+kin_time_invariant_2sex(
+ pf = NULL,
+ pm = NULL,
+ ff = NULL,
+ fm = NULL,
+ sex_focal = "f",
+ birth_female = 1/2.04,
+ pif = NULL,
+ pim = NULL,
+ output_kin = NULL,
+ list_output = FALSE
+)
+}
+\arguments{
+\item{pf}{numeric. A vector of survival probabilities for females with same length as ages.}
+
+\item{pm}{numeric. A vector of survival probabilities for males with same length as ages.}
+
+\item{ff}{numeric. A vector of age-specific fertility rates for females with same length as ages.}
+
+\item{fm}{numeric. A vector of age-specific fertility rates for males with same length as ages.}
+
+\item{sex_focal}{character. "f" for female or "m" for male.}
+
+\item{birth_female}{numeric. Female portion at birth.}
+
+\item{pif}{numeric. For using some specific non-stable age distribution of childbearing for mothers (same length as ages). Default \code{NULL}.}
+
+\item{pim}{numeric. For using some specific non-stable age distribution of childbearing for fathers (same length as ages). Default \code{NULL}.}
+
+\item{output_kin}{character. kin to return, considering matrilineal names. For example "m" for parents, "d" for children, etc. See the \code{vignette} for all kin types.}
+
+\item{list_output}{logical. Results as a list with \code{output_kin} elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default \code{FALSE}}
+}
+\value{
+A data frame with focal´s age, related ages and type of kin
+(for example \code{d} is children, \code{oa} is older aunts/uncles, etc.), sex, alive and death. If \code{list_output = TRUE} then this is a list.
+}
+\description{
+Two-sex matrix framework for kin count estimates.This produces kin counts grouped by kin, age and sex of
+each relatives at each Focal´s age. For example, male cousins from aunts and uncles from different sibling's parents
+are grouped in one male count of cousins.
+}
+\details{
+See Caswell (2022) for details on formulas.
+}
diff --git a/man/kin_time_invariant_2sex_cod.Rd b/man/kin_time_invariant_2sex_cod.Rd
new file mode 100644
index 0000000..6645ca0
--- /dev/null
+++ b/man/kin_time_invariant_2sex_cod.Rd
@@ -0,0 +1,59 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_time_invariant_2sex_cod.R
+\name{kin_time_invariant_2sex_cod}
+\alias{kin_time_invariant_2sex_cod}
+\title{Estimate kin counts in a time invariant framework for two-sex model.}
+\usage{
+kin_time_invariant_2sex_cod(
+ pf = NULL,
+ pm = NULL,
+ ff = NULL,
+ fm = NULL,
+ Hf = NULL,
+ Hm = NULL,
+ sex_focal = "f",
+ birth_female = 1/2.04,
+ pif = NULL,
+ pim = NULL,
+ output_kin = NULL,
+ list_output = FALSE
+)
+}
+\arguments{
+\item{pf}{numeric. A vector of survival probabilities for females with same length as ages.}
+
+\item{pm}{numeric. A vector of survival probabilities for males with same length as ages.}
+
+\item{ff}{numeric. A vector of age-specific fertility rates for females with same length as ages.}
+
+\item{fm}{numeric. A vector of age-specific fertility rates for males with same length as ages.}
+
+\item{Hf}{numeric. A matrix with cause-specific hazards for females with rows as causes and columns as ages, being the name of each col the age.}
+
+\item{Hm}{numeric. A matrix with cause-specific hazards for males with rows as causes and columns as ages, being the name of each col the age.}
+
+\item{sex_focal}{character. "f" for female or "m" for male.}
+
+\item{birth_female}{numeric. Female portion at birth.}
+
+\item{pif}{numeric. For using some specific non-stable age distribution of childbearing for mothers (same length as ages). Default \code{NULL}.}
+
+\item{pim}{numeric. For using some specific non-stable age distribution of childbearing for fathers (same length as ages). Default \code{NULL}.}
+
+\item{output_kin}{character. kin to return, considering matrilineal names. For example "m" for parents, "d" for children, etc. See the \code{vignette} for all kin types.}
+
+\item{list_output}{logical. Results as a list with \code{output_kin} elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default \code{FALSE}}
+}
+\value{
+A data frame with focal´s age, related ages and type of kin
+(for example \code{d} is children, \code{oa} is older aunts/uncles, etc.), sex, alive and death. If \code{list_output = TRUE} then this is a list.
+}
+\description{
+Two-sex matrix framework for kin count and death estimates.This produces kin counts grouped by kin, age and sex of
+each relatives at each Focal´s age. For example, male cousins from aunts and uncles from different sibling's parents
+are grouped in one male count of cousins. This also produces kin deaths grouped by kin, age, sex of
+each relatives at each Focal´s age, and cause of death.
+}
+\details{
+See Caswell (2022) for details on formulas.
+}
diff --git a/man/kin_time_variant.Rd b/man/kin_time_variant.Rd
index da16ad7..787052f 100644
--- a/man/kin_time_variant.Rd
+++ b/man/kin_time_variant.Rd
@@ -2,13 +2,13 @@
% Please edit documentation in R/kin_time_variant.R
\name{kin_time_variant}
\alias{kin_time_variant}
-\title{Estimate kin counts in a time variant framework}
+\title{Estimate kin counts in a time variant framework (dynamic rates) for one-sex model (matrilineal/patrilineal)}
\usage{
kin_time_variant(
- U = NULL,
+ p = NULL,
f = NULL,
- N = NULL,
pi = NULL,
+ n = NULL,
output_cohort = NULL,
output_period = NULL,
output_kin = NULL,
@@ -17,14 +17,14 @@ kin_time_variant(
)
}
\arguments{
-\item{U}{numeric. A matrix of survival ratios with rows as ages and columns as years. Column names must be equal interval.}
+\item{p}{numeric. A matrix of survival ratios with rows as ages and columns as years. Column names must be equal interval.}
\item{f}{numeric. A matrix of age-specific fertility rates with rows as ages and columns as years. Coincident with \code{U}.}
-\item{N}{numeric. A matrix of population with rows as ages and columns as years. Coincident with \code{U}.}
-
\item{pi}{numeric. A matrix with distribution of childbearing with rows as ages and columns as years. Coincident with \code{U}.}
+\item{n}{numeric. A matrix of population with rows as ages and columns as years. Coincident with \code{U}.}
+
\item{output_cohort}{integer. Year of birth of focal to return as output. Could be a vector. Should be within input data years range.}
\item{output_period}{integer. Year for which to return kinship structure. Could be a vector. Should be within input data years range.}
@@ -36,9 +36,12 @@ kin_time_variant(
\item{list_output}{logical. Results as a list with years elements (as a result of \code{output_cohort} and \code{output_period} combination), with a second list of \code{output_kin} elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default \code{FALSE}}
}
\value{
-A data frame of population kinship structure, with focal's cohort, focal´s age, period year, type of relatives
+A data frame of population kinship structure, with Focal's cohort, focal´s age, period year, type of relatives
(for example \code{d} is daughter, \code{oa} is older aunts, etc.), living and death kin counts, and age of (living or time deceased) relatives. If \code{list_output = TRUE} then this is a list.
}
\description{
-Implementation of time variant Goodman-Keyfitz-Pullum equations based on Caswell (2021).
+Matrix implementation of time variant Goodman-Keyfitz-Pullum equations in a matrix framework.
+}
+\details{
+See Caswell (2021) for details on formulas.
}
diff --git a/man/kin_time_variant_2sex.Rd b/man/kin_time_variant_2sex.Rd
new file mode 100644
index 0000000..a30624f
--- /dev/null
+++ b/man/kin_time_variant_2sex.Rd
@@ -0,0 +1,63 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_time_variant_2sex.R
+\name{kin_time_variant_2sex}
+\alias{kin_time_variant_2sex}
+\title{Estimate kin counts in a time variant framework (dynamic rates) in a two-sex framework (Caswell, 2022)}
+\usage{
+kin_time_variant_2sex(
+ pf = NULL,
+ pm = NULL,
+ ff = NULL,
+ fm = NULL,
+ sex_focal = "f",
+ birth_female = 1/2.04,
+ pif = NULL,
+ pim = NULL,
+ nf = NULL,
+ nm = NULL,
+ output_cohort = NULL,
+ output_period = NULL,
+ output_kin = NULL,
+ list_output = FALSE
+)
+}
+\arguments{
+\item{pf}{numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).}
+
+\item{pm}{numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).}
+
+\item{ff}{numeric. Same as pf but for fertility rates.}
+
+\item{fm}{numeric. Same as pm but for fertility rates.}
+
+\item{sex_focal}{character. "f" for female or "m" for male.}
+
+\item{birth_female}{numeric. Female portion at birth. This multiplies \code{f} argument. If \code{f} is already for female offspring, this needs to be set as 1.}
+
+\item{pif}{numeric. For using some specific age distribution of childbearing for mothers (same length as ages). Default \code{NULL}.}
+
+\item{pim}{numeric. For using some specific age distribution of childbearing for fathers (same length as ages). Default \code{NULL}.}
+
+\item{nf}{numeric. Same as pf but for population distribution (counts or \verb{\%}). Optional.}
+
+\item{nm}{numeric. Same as pm but for population distribution (counts or \verb{\%}). Optional.}
+
+\item{output_cohort}{integer. Vector of year cohorts for returning results. Should be within input data years range.}
+
+\item{output_period}{integer. Vector of period years for returning results. Should be within input data years range.}
+
+\item{output_kin}{character. kin types to return: "m" for mother, "d" for daughter,...}
+
+\item{list_output}{logical. Results as a list with years elements (as a result of \code{output_cohort} and \code{output_period} combination), with a second list of \code{output_kin} elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default \code{FALSE}}
+}
+\value{
+A data.frame with year, cohort, Focal´s age, related ages, sex and type of kin (for example \code{d} is daughter, \code{oa} is older aunts, etc.), including living and dead kin at that age and sex.
+}
+\description{
+Two-sex matrix framework for kin count estimates with varying rates.
+This produces kin counts grouped by kin, age and sex of each relatives at each Focal´s age.
+For example, male cousins from aunts and uncles from different sibling's parents are grouped in one male count of cousins.
+}
+\details{
+See Caswell (2022) for details on formulas.
+}
diff --git a/man/kin_time_variant_2sex_cod.Rd b/man/kin_time_variant_2sex_cod.Rd
new file mode 100644
index 0000000..c0db9a8
--- /dev/null
+++ b/man/kin_time_variant_2sex_cod.Rd
@@ -0,0 +1,70 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_time_variant_2sex_cod.R
+\name{kin_time_variant_2sex_cod}
+\alias{kin_time_variant_2sex_cod}
+\title{Estimate kin counts in a time variant framework (dynamic rates) in a two-sex framework (Caswell, 2022)}
+\usage{
+kin_time_variant_2sex_cod(
+ pf = NULL,
+ pm = NULL,
+ ff = NULL,
+ fm = NULL,
+ Hf = NULL,
+ Hm = NULL,
+ sex_focal = "f",
+ birth_female = 1/2.04,
+ pif = NULL,
+ pim = NULL,
+ nf = NULL,
+ nm = NULL,
+ output_cohort = NULL,
+ output_period = NULL,
+ output_kin = NULL,
+ list_output = FALSE
+)
+}
+\arguments{
+\item{pf}{numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).}
+
+\item{pm}{numeric. A vector (atomic) or matrix with probabilities (or survival ratios, or transition between age class in a more general perspective) with rows as ages (and columns as years in case of matrix, being the name of each col the year).}
+
+\item{ff}{numeric. Same as pf but for fertility rates.}
+
+\item{fm}{numeric. Same as pm but for fertility rates.}
+
+\item{Hf}{numeric. A list where each list element (being the name of each list element the year) contains a matrix with cause-specific hazards for females with rows as causes and columns as ages, being the name of each col the age.}
+
+\item{Hm}{numeric. A list where each list element (being the name of each list element the year) contains a matrix with cause-specific hazards for males with rows as causes and columns as ages, being the name of each col the age.}
+
+\item{sex_focal}{character. "f" for female or "m" for male.}
+
+\item{birth_female}{numeric. Female portion at birth. This multiplies \code{f} argument. If \code{f} is already for female offspring, this needs to be set as 1.}
+
+\item{pif}{numeric. For using some specific age distribution of childbearing for mothers (same length as ages). Default \code{NULL}.}
+
+\item{pim}{numeric. For using some specific age distribution of childbearing for fathers (same length as ages). Default \code{NULL}.}
+
+\item{nf}{numeric. Same as pf but for population distribution (counts or \verb{\%}). Optional.}
+
+\item{nm}{numeric. Same as pm but for population distribution (counts or \verb{\%}). Optional.}
+
+\item{output_cohort}{integer. Vector of year cohorts for returning results. Should be within input data years range.}
+
+\item{output_period}{integer. Vector of period years for returning results. Should be within input data years range.}
+
+\item{output_kin}{character. kin types to return: "m" for mother, "d" for daughter,...}
+
+\item{list_output}{logical. Results as a list with years elements (as a result of \code{output_cohort} and \code{output_period} combination), with a second list of \code{output_kin} elements, with focal´s age in columns and kin ages in rows (2 * ages, last chunk of ages for death experience). Default \code{FALSE}}
+}
+\value{
+A data.frame with year, cohort, Focal´s age, related ages, sex and type of kin (for example \code{d} is daughter, \code{oa} is older aunts, etc.), including living and dead kin at that age and sex.
+}
+\description{
+Two-sex matrix framework for kin count estimates with varying rates.
+This produces kin counts grouped by kin, age and sex of each relatives at each Focal´s age.
+For example, male cousins from aunts and uncles from different sibling's parents are grouped in one male count of cousins. This also produces kin deaths grouped by kin, age, sex of
+each relatives at each Focal´s age, and cause of death.
+}
+\details{
+See Caswell (2022) for details on formulas.
+}
diff --git a/man/output_period_cohort_combination.Rd b/man/output_period_cohort_combination.Rd
index 5b20baf..62fc02e 100644
--- a/man/output_period_cohort_combination.Rd
+++ b/man/output_period_cohort_combination.Rd
@@ -2,7 +2,7 @@
% Please edit documentation in R/kin_time_variant.R
\name{output_period_cohort_combination}
\alias{output_period_cohort_combination}
-\title{defince apc combination to return}
+\title{APC combination to return}
\usage{
output_period_cohort_combination(
output_cohort = NULL,
@@ -11,6 +11,22 @@ output_period_cohort_combination(
years_data = NULL
)
}
+\arguments{
+\item{output_cohort}{integer. A vector with selected calendar years.}
+
+\item{output_period}{integer. A vector with selected cohort years.}
+
+\item{age}{integer. A vector with ages from the kinship network to be filtered.}
+
+\item{years_data}{integer. A vector with years from the time-varying kinship network to be filtered.}
+}
+\value{
+data.frame with years and ages to filter in \code{kin} and \code{kin_2sex} functions.
+}
\description{
-defince apc to return.
+define APC combination to return in \code{kin} and \code{kin2sex}.
+}
+\details{
+Because returning all period and cohort data from a huge time-series would be hard memory consuming,
+this function is an auxiliary one to deal with selection from inputs \code{output_cohort} and \code{output_period}.
}
diff --git a/man/pi_mix.Rd b/man/pi_mix.Rd
new file mode 100644
index 0000000..0ed3c83
--- /dev/null
+++ b/man/pi_mix.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_multi_stage_time_variant_2sex.R
+\name{pi_mix}
+\alias{pi_mix}
+\title{Mixing distributions for the time-invariant multi-state 2-sex model: Non-parity case}
+\usage{
+pi_mix(Uf, Um, Ff, Fm, alpha, na, ns)
+}
+\arguments{
+\item{Uf}{matrix. Block-structured matrix which transfers females over stage and advances their age}
+
+\item{Um}{matrix. Block-structured matrix which transfers males over stage and advances their age}
+
+\item{Ff}{matrix. Block-structured matrix which counts reproduction by females and assigns newborns an age and stage}
+
+\item{Fm}{matrix. Block-structured matrix which counts reproduction by males and assigns newborns an age and stage}
+
+\item{alpha}{scalar. Birth ratio male:female}
+
+\item{na}{scalar. Number of age-classes}
+
+\item{ns}{scalar. Number of stages}
+}
+\value{
+list (of vectors). list[\link{1}] = full age\emph{stage}sex distribution
+list[\link{2}] = female age\emph{stage distribution normalised
+list[\link{3}] = male age}stage distribution normalised
+list[\link{4}] = female marginal age distribution normalised
+list[\link{5}] = male marginal age distribution normalised
+}
+\description{
+Mixing distributions for the time-invariant multi-state 2-sex model: Non-parity case
+}
diff --git a/man/pi_mix_TV.Rd b/man/pi_mix_TV.Rd
new file mode 100644
index 0000000..5f39775
--- /dev/null
+++ b/man/pi_mix_TV.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_multi_stage_time_variant_2sex.R
+\name{pi_mix_TV}
+\alias{pi_mix_TV}
+\title{Mixing distributions for the time-variant multi-state 2-sex model: Non-parity case}
+\usage{
+pi_mix_TV(Ff, Fm, alpha, na, ns, previous_age_stage_dist)
+}
+\arguments{
+\item{Ff}{matrix. Block-structured matrix which counts reproduction by females and assigns newborns an age and stage}
+
+\item{Fm}{matrix. Block-structured matrix which counts reproduction by males and assigns newborns an age and stage}
+
+\item{alpha}{scalar. Birth ratio male:female}
+
+\item{na}{scalar. Number of age-classes}
+
+\item{ns}{scalar. Number of stages}
+
+\item{previous_age_stage_dist}{vector. Last years population structure (age\emph{stage}sex full distribution)}
+}
+\value{
+list (of vectors). list[\link{1}] = full age\emph{stage}sex distribution
+list[\link{2}] = female age\emph{stage distribution normalised
+list[\link{3}] = male age}stage distribution normalised
+list[\link{4}] = female marginal age distribution normalised
+list[\link{5}] = male marginal age distribution normalised
+}
+\description{
+Mixing distributions for the time-variant multi-state 2-sex model: Non-parity case
+}
diff --git a/man/pi_mix_TV_parity.Rd b/man/pi_mix_TV_parity.Rd
new file mode 100644
index 0000000..9a95ab8
--- /dev/null
+++ b/man/pi_mix_TV_parity.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_multi_stage_time_variant_2sex.R
+\name{pi_mix_TV_parity}
+\alias{pi_mix_TV_parity}
+\title{Mixing distributions for the time-variant multi-state 2-sex model: Parity-specific case}
+\usage{
+pi_mix_TV_parity(Ff, Fm, alpha, na, ns, previous_age_stage_dist)
+}
+\arguments{
+\item{Ff}{matrix. Block-structured matrix which counts reproduction by females and assigns newborns an age and stage}
+
+\item{Fm}{matrix. Block-structured matrix which counts reproduction by males and assigns newborns an age and stage}
+
+\item{alpha}{scalar. Birth ratio male:female}
+
+\item{na}{scalar. Number of age-classes}
+
+\item{ns}{scalar. Number of stages}
+
+\item{previous_age_stage_dist}{vector. Last years population structure (age\emph{stage}sex full distribution)}
+
+\item{Uf}{matrix. Block-structured matrix which transfers females over stage and advances their age}
+
+\item{Um}{matrix. Block-structured matrix which transfers males over stage and advances their age}
+}
+\value{
+list (of vectors). list[\link{1}] = full age\emph{stage}sex distribution
+list[\link{2}] = female age\emph{stage distribution normalised
+list[\link{3}] = male age}stage distribution normalised
+list[\link{4}] = female marginal age distribution normalised
+list[\link{5}] = male marginal age distribution normalised
+}
+\description{
+Mixing distributions for the time-variant multi-state 2-sex model: Parity-specific case
+}
diff --git a/man/pi_mix_parity.Rd b/man/pi_mix_parity.Rd
new file mode 100644
index 0000000..f3874c8
--- /dev/null
+++ b/man/pi_mix_parity.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_multi_stage_time_variant_2sex.R
+\name{pi_mix_parity}
+\alias{pi_mix_parity}
+\title{Mixing distributions for the time-invariant multi-state 2-sex model: Parity-specific case}
+\usage{
+pi_mix_parity(Uf, Um, Ff, Fm, alpha, na, ns)
+}
+\arguments{
+\item{Uf}{matrix. Block-structured matrix which transfers females over stage and advances their age}
+
+\item{Um}{matrix. Block-structured matrix which transfers males over stage and advances their age}
+
+\item{Ff}{matrix. Block-structured matrix which counts reproduction by females and assigns newborns an age and stage}
+
+\item{Fm}{matrix. Block-structured matrix which counts reproduction by males and assigns newborns an age and stage}
+
+\item{alpha}{scalar. Birth ratio male:female}
+
+\item{na}{scalar. Number of age-classes}
+
+\item{ns}{scalar. Number of stages}
+}
+\value{
+list (of vectors). list[\link{1}] = full age\emph{stage}sex distribution
+list[\link{2}] = female age\emph{stage distribution normalised
+list[\link{3}] = male age}stage distribution normalised
+list[\link{4}] = female marginal age distribution normalised
+list[\link{5}] = male marginal age distribution normalised
+}
+\description{
+Mixing distributions for the time-invariant multi-state 2-sex model: Parity-specific case
+}
diff --git a/man/plot_diagram.Rd b/man/plot_diagram.Rd
index 8d2448c..fdce2a5 100644
--- a/man/plot_diagram.Rd
+++ b/man/plot_diagram.Rd
@@ -7,13 +7,13 @@
plot_diagram(kin_total, rounding = 3)
}
\arguments{
-\item{kin_total}{data.frame. With columns \code{kin} with type and \code{count} with some measeure.}
+\item{kin_total}{data.frame. values in column \code{kin} define the relative type - see \code{demokin_codes()}. Values in column \code{count} are the expected number of relatives.}
-\item{rounding}{numeric. Estimation could have a lot of decimals. Rounding will make looks more clear the diagramm.}
+\item{rounding}{numeric. Number of decimals to show in diagram.}
}
\value{
-A plot
+A Keyfitz-style kinship plot.
}
\description{
-Given estimation of kin counts from \code{kins} function, draw a network diagramm.
+Draws a Keyfitz-style kinship diagram given a kinship object created by the \code{kin} function. Displays expected kin counts for a Focal aged 'a'.
}
diff --git a/man/rename_kin.Rd b/man/rename_kin.Rd
index 023cf99..b5d195b 100644
--- a/man/rename_kin.Rd
+++ b/man/rename_kin.Rd
@@ -4,8 +4,19 @@
\alias{rename_kin}
\title{rename kin}
\usage{
-rename_kin(df, consolidate_column = "no")
+rename_kin(df, sex = "f")
+}
+\arguments{
+\item{df}{data.frame. A data frame with variable \code{kin} with \code{DemoKin} codes to be labelled.}
+
+\item{sex}{character. "f" for female, "m" for male or "2sex" for both sex naming.}
+}
+\value{
+Add a column with kin labels in the input data frame.
}
\description{
-Rename kin labels depending consolidate some types
+Add kin labels depending the sex
+}
+\details{
+See table \code{demokin_codes} to know label options.
}
diff --git a/man/timevarying_kin.Rd b/man/timevarying_kin.Rd
index 1826543..ac481c9 100644
--- a/man/timevarying_kin.Rd
+++ b/man/timevarying_kin.Rd
@@ -17,6 +17,9 @@ timevarying_kin(Ut, ft, pit, ages, pkin)
\item{pkin}{numeric. A list with kin count distribution in previous year.}
}
+\value{
+A list of 14 types of kin matrices (kin age by Focal age) projected one time interval.
+}
\description{
one time projection kin. internal function.
}
diff --git a/man/timevarying_kin_2sex.Rd b/man/timevarying_kin_2sex.Rd
new file mode 100644
index 0000000..abf1774
--- /dev/null
+++ b/man/timevarying_kin_2sex.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_time_variant_2sex.R
+\name{timevarying_kin_2sex}
+\alias{timevarying_kin_2sex}
+\title{one time projection kin}
+\usage{
+timevarying_kin_2sex(Ut, Ft, Ft_star, pit, sex_focal, ages, pkin)
+}
+\arguments{
+\item{Ut}{numeric. A matrix of survival probabilities (or ratios).}
+
+\item{Ft}{numeric. A matrix of age-specific fertility rates.}
+
+\item{Ft_star}{numeric. Ft but for female fertility.}
+
+\item{pit}{numeric. A matrix with distribution of childbearing.}
+
+\item{sex_focal}{character. "f" for female or "m" for male.}
+
+\item{ages}{numeric.}
+
+\item{pkin}{numeric. A list with kin count distribution in previous year.}
+}
+\value{
+A list of 14 types of kin matrices (kin age by Focal age, blocked for two sex) projected one time interval.
+}
+\description{
+one time projection kin. internal function.
+}
diff --git a/man/timevarying_kin_2sex_cod.Rd b/man/timevarying_kin_2sex_cod.Rd
new file mode 100644
index 0000000..fb82bad
--- /dev/null
+++ b/man/timevarying_kin_2sex_cod.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/kin_time_variant_2sex_cod.R
+\name{timevarying_kin_2sex_cod}
+\alias{timevarying_kin_2sex_cod}
+\title{one time projection kin}
+\usage{
+timevarying_kin_2sex_cod(Ut, Ft, Ft_star, causes, pit, sex_focal, ages, pkin)
+}
+\arguments{
+\item{Ut}{numeric. A matrix of survival probabilities (or ratios).}
+
+\item{Ft}{numeric. A matrix of age-specific fertility rates.}
+
+\item{Ft_star}{numeric. Ft but for female fertility.}
+
+\item{causes}{integer. Number of causes of death included.}
+
+\item{pit}{numeric. A matrix with distribution of childbearing.}
+
+\item{sex_focal}{character. "f" for female or "m" for male.}
+
+\item{ages}{numeric.}
+
+\item{pkin}{numeric. A list with kin count distribution in previous year.}
+}
+\value{
+A list of 14 types of kin matrices (kin age by Focal age, blocked for two sex) projected one time interval.
+}
+\description{
+one time projection kin. internal function.
+}
diff --git a/tests/testthat/test-kin_multi_stage.R b/tests/testthat/test-kin_multi_stage.R
index 2e3d58d..d7a845b 100644
--- a/tests/testthat/test-kin_multi_stage.R
+++ b/tests/testthat/test-kin_multi_stage.R
@@ -4,7 +4,8 @@ test_that("same output in multi_stage (caswell 2020)", {
demokin_svk1990_caswell2020 <- kin_multi_stage(U = svk_Uxs,
f = svk_fxs,
D = svk_pxs,
- H = svk_Hxs, birth_female=1, list_output = TRUE)
+ H = svk_Hxs, birth_female=1,
+ list_output = TRUE, parity = TRUE)
expect_equal(demokin_svk1990_caswell2020$d[1:(110*6),], kin_svk1990_caswell2020$d)
expect_equal(demokin_svk1990_caswell2020$gd[1:(110*6),], kin_svk1990_caswell2020$gd)
expect_equal(demokin_svk1990_caswell2020$ggd[1:(110*6),], kin_svk1990_caswell2020$ggd)
diff --git a/tests/testthat/test-kin_twosex_multistate_timevariant.R b/tests/testthat/test-kin_twosex_multistate_timevariant.R
new file mode 100644
index 0000000..dbb5697
--- /dev/null
+++ b/tests/testthat/test-kin_twosex_multistate_timevariant.R
@@ -0,0 +1,76 @@
+
+# Here I test the two-sex time-variant multi-stage function against caswell 2020. To do so I restrict the input years
+# to only 1990 (so the model becomes invariant, and restrict the output results to females only)
+
+# Technical note: to ensure that the two sex c(pi_f, pi_m) has a pi_f equal to the pi used in Caswell 2020 we need to guarantee
+# that the spectral radius of the block structured A = U_proj + F_star comes from the upper-left block:
+
+# A = [U_fem , 0 ; 0 , U_male] + [(1-alpha)*F_fem , 0 ; alpha*F_male , 0].
+# If lambda spectral radius of A[1:n,1:n] then lambda*w[1:n] = A[1,1] %*% w[1:n] = (U_fem + (1-alpha)*F_fem) %*% w[1:n] then w[1:n]*(1/(1-alpha)) %*% F_fem[1,] is the same pi used in Caswell.
+# However, if lambda comes from bottom right block of A then w[1:n]*F_fem[1,] is not the same as pi in Caswell 2020.
+# Numerically check!
+
+
+test_that("same output in multi_stage (caswell 2020)", {
+ Tf <- svk_Uxs
+ Tm <- svk_Uxs
+ Ff <- svk_fxs
+ Fm <- svk_fxs
+ Ff <- (1/0.49)*Ff
+ Fm <- (1/0.49)*Fm
+ Uf <- svk_pxs
+ Um <- svk_pxs
+ H <- svk_Hxs
+
+ joe_output <- kin_multi_stage_time_variant_2sex(list(Uf),
+ list(Um),
+ list(Ff),
+ list(Fm),
+ list(Tf),
+ list(Tm),
+ list(H),
+ birth_female = 0.49, ## svk_fxs already divided
+ output_kin = NULL,
+ parity = TRUE,
+ summary_kin = FALSE,
+ sex_Focal = "Female", ## define Focal's sex at birth
+ initial_stage_Focal = 1, ## Define Focal's stage at birth
+ output_years = seq(1990, (1990)))
+
+
+ ## Younger sisters
+ jcmp_ys <- joe_output %>% dplyr::filter(sex_kin == "Female", group == "ys") %>%
+ dplyr::select(age_focal, age_kin, stage_kin, count) %>%
+ dplyr::transmute(age_focal = age_focal, age_kin = age_kin, stage_kin = stage_kin, count = count) # Joe's
+ hals_output_ys <- kin_svk1990_caswell2020$ys # Hal's
+ hals_output_ys <- as.data.frame(hals_output_ys)
+ colnames(hals_output_ys) <- seq(0,109,1)
+ hals_output_ys$age_kin <- rep(seq(0, (110-1), 1), each = 6)
+ hals_output_ys$stage_kin <- rep(seq(1, 6), 110)
+ hcmp_ys <- hals_output_ys %>% reshape2::melt(id = c("age_kin","stage_kin")) %>%
+ dplyr::mutate(age_focal = variable,
+ count = value) %>%
+ dplyr::select(age_kin, stage_kin, age_focal, count) %>%
+ dplyr::transmute(age_focal = age_focal, age_kin = age_kin, stage_kin = stage_kin, count = count)
+
+ ## Older sisters
+ jcmp_os <- joe_output %>% dplyr::filter(sex_kin == "Female", group == "os") %>%
+ dplyr::select(age_focal, age_kin, stage_kin, count) %>%
+ dplyr::transmute(age_focal = age_focal, age_kin = age_kin, stage_kin = stage_kin, count = count) # Joe's
+ hals_output_os <- kin_svk1990_caswell2020$os # Hal's
+ hals_output_os <- as.data.frame(hals_output_os)
+ colnames(hals_output_os) <- seq(0,109,1)
+ hals_output_os$age_kin <- rep(seq(0, (110-1), 1), each = 6)
+ hals_output_os$stage_kin <- rep(seq(1, 6), 110)
+ hcmp_os <- hals_output_os %>% reshape2::melt(id = c("age_kin","stage_kin")) %>%
+ dplyr::mutate(age_focal = variable,
+ count = value) %>%
+ dplyr::select(age_kin, stage_kin, age_focal, count) %>%
+ dplyr::transmute(age_focal = age_focal, age_kin = age_kin, stage_kin = stage_kin, count = count)
+
+ ## Check equivalence
+ expect_equal(jcmp_ys$count, hcmp_ys$count)
+ expect_equal(jcmp_os$count, hcmp_os$count)
+
+
+})
diff --git a/vignettes/0_0_Papers.Rmd b/vignettes/0_0_Papers.Rmd
new file mode 100644
index 0000000..ace0760
--- /dev/null
+++ b/vignettes/0_0_Papers.Rmd
@@ -0,0 +1,64 @@
+---
+title: "Papers using DemoKin"
+output:
+ html_document:
+ toc: true
+ toc_float:
+ collapsed: false
+ smooth_scroll: true
+ theme: readable
+ highlight: pygments
+ df_print: paged
+ fig_caption: true
+---
+
+## Published Articles and Pre-prints using DemoKin
+
+Acosta, E., Alburez-Gutierrez, D., Gargiulo, M., & Torres, C. (2025). *Weaponizing kinship: A demographic analysis of bereavement in the Colombian conflict* (Version 1) [Preprint]. SocArXiv.
+
+Alburez-Gutierrez, D., Acosta, E., Zagheni, E., & Williams, N. E. (2024). The long-lasting effect of armed-conflict deaths on the living: Quantifying family bereavement. *Science Advances, 10*(30), eado6951.
+
+Alburez-Gutierrez, D., Basellini, U., & Zagheni, E. (2024). When do mothers bury a child? Heterogeneity in the maternal age at offspring loss across the demographic transition. *Population Studies*. Advance online publication.
+
+Alburez-Gutierrez, D., Williams, I., & Caswell, H. (2023). Projections of human kinship for all countries. *Proceedings of the National Academy of Sciences, 120*(52), e2315722120.
+
+Adhikari, S., & Alburez-Gutierrez, D. (2025). *The future of grandparenthood in South Asia: The role of population aging and educational expansion* (MPIDR Working Paper WP-2025-003). Max Planck Institute for Demographic Research.
+
+Ellis, S., Franks, D. W., Nielsen, M. L. K., Weiss, M. N., Croft, D. P., *et al.* (2024). The evolution of menopause in toothed whales. *Nature, 627*, 579–585.
+
+Feng, K., Song, X., & Caswell, H. (2024). Kinship and care: Racial disparities in potential dementia caregiving in the United States from 2000 to 2060. *The Journals of Gerontology: Series A, 79*(Suppl 1), S32–S41.
+
+Hünteler, B. M., Polizzi, A., & van Raalte, A. A. (2024). *Changing kinship structures in East and West Germany before and after reunification* [Preprint]. SocArXiv.
+
+Jiang, S., Zuo, W., Guo, Z., Caswell, H., & Tuljapurkar, S. (2023). How does the demographic transition affect kinship networks? *Demographic Research, 48*, 899–930.
+
+Jiang, S., Zuo, W., Guo, Z., & Tuljapurkar, S. (in press). Changing demographic rates reshape kinship networks. *Demography*.
+
+Matos-Moreno, A., Alburez-Gutierrez, D., Verdery, A. M., Santos-Lozada, A. R., Fernández Soto, M., & Williams, I. (2025). Kinship structures for left-behind older adults in high-out-migration contexts: Evidence from Puerto Rico. *The Journals of Gerontology: Series B, 80*(6), gbaf052.
+
+Robles, A., Martes-Camargo, P., & Rodríguez-Franco, R. (2024). ¿Quién cuida a la niña? Provisión de cuidados y estructura de parentesco en América Latina [Who takes care of the girl? Care provision and kinship structure in Latin America]. *Revista Brasileira de Estudos de População, 41*, e0274, 1–24.
+
+Schlüter, B.-S., Alburez-Gutierrez, D., Bibbins-Domingo, K., Alexander, M. J., & Kiang, M. V. (2024). Youth experiencing parental death due to drug poisoning and firearm violence in the US, 1999–2020. *JAMA, 331*(20), 1741–1747.
+
+Snyder, M., Alburez-Gutierrez, D., Williams, I., & Zagheni, E. (2022). Estimates from 31 countries show the significant impact of COVID-19 excess mortality on the incidence of family bereavement. *Proceedings of the National Academy of Sciences of the United States of America, 119*(26), e2202686119.
+
+Song, X., & Caswell, H. (2022). The role of kinship in racial differences in exposure to unemployment. *Demography, 59*(4), 1325–1352.
+
+van Damme, M., Alburez-Gutierrez, D., & Castro, A. (2025). Estimating kinship size of older adults in Europe with models and surveys. *Demography*, 1–1961236.
+
+## Formal demography papers
+
+Butterick, J. W. B., Smith, P. W. F., Bijak, J., & Hilton, J. (2025). A mathematical framework for time-variant multi-state kinship modelling. *Theoretical Population Biology, 163*, 1–12.
+
+
+Caswell, H. (2019). The formal demography of kinship: A matrix formulation. *Demographic Research, 41*(24), 679–712.
+
+Caswell, H. (2020). The formal demography of kinship II: Multistate models, parity, and sibship. *Demographic Research, 42*(38), 1097–1146.
+
+Caswell, H., & Song, X. (2021). The formal demography of kinship III: Kinship dynamics with time-varying demographic rates. *Demographic Research, 45*(16), 517–546.
+
+Caswell, H. (2022). The formal demography of kinship IV: Two-sex models and their approximations. *Demographic Research, 47*(13), 359–396.
+
+Caswell, H., Margolis, R., & Verdery, A. M. (2023). The formal demography of kinship V: Kin loss, bereavement, and causes of death. *Demographic Research, 49*(41), 1163–1200.
+
+Caswell, H. (2024). The formal demography of kinship VI: Demographic stochasticity and variance in the kinship network. *Demographic Research, 51*(39), 1201–1256.
diff --git a/vignettes/1_1_OneSex_TimeInvariant_Age.Rmd b/vignettes/1_1_OneSex_TimeInvariant_Age.Rmd
new file mode 100644
index 0000000..1f7aa31
--- /dev/null
+++ b/vignettes/1_1_OneSex_TimeInvariant_Age.Rmd
@@ -0,0 +1,474 @@
+---
+title: "One-sex time-invariant kinship model specified by age"
+output:
+ html_document:
+ toc: true
+ toc_float:
+ collapsed: false
+ smooth_scroll: true
+ theme: readable
+ highlight: pygments
+ number_sections: true
+ code_folding: show
+ df_print: paged
+ fig_caption: true
+bibliography: references.bib
+vignette: >
+ %\VignetteIndexEntry{One-sex time-invariant kinship model specified by age}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include=FALSE}
+# Set up code chunk options
+knitr::opts_chunk$set(echo = TRUE,
+ message = FALSE,
+ warning = FALSE,
+ fig.align = 'center',
+ fig.width = 8,
+ fig.height = 6,
+ dpi = 300)
+# Prevent scientific notation (useful for the rate calculation)
+options(scipen = 999999)
+pkgload::load_all()
+```
+
+
+
+
+Learning Objectives: In this tutorial, you will learn how to use the DemoKin package to analyze kinship networks, understand the mechanics of one-sex time-invariant models, and visualize kinship dynamics across the life course.
+
+
+# Introduction {#introduction}
+
+Kinship is a fundamental property of human populations and a key form of social structure. Demographers have long been interested in the interplay between demographic change and family configuration. This has led to the development of sophisticated methodological and conceptual approaches for the study of kinship, some of which are explored in this tutorial.
+
+Kinship analysis can answer a range of important questions:
+
+- How many relatives might people have at different ages, and what is the age distribution of these relatives?
+- How does family structure (both the number and age distribution of kin) evolve as populations undergo demographic transition?
+
+In this tutorial, we will implement matrix kinship models using the `DemoKin` package to calculate kin counts and age distributions. We begin with the simplest model: a **time-invariant one-sex model**, outlined in Caswell [-@caswell_formal_2019]. In this model, we assume that everyone in the population experiences the same mortality and fertility rates throughout their lives (e.g., the 2015 rates), and we only trace female kin relationships.
+
+## Preparation {#preparation}
+
+Before starting the session, please ensure you complete the following preparatory steps:
+
+1. If you haven't already, install R and RStudio. This is a useful tutorial: https://rstudio-education.github.io/hopr/starting.html
+2. Install the following packages in R:
+
+```{r installs, eval=FALSE}
+# Install basic data analysis packages
+rm(list = ls())
+install.packages("dplyr") # Data manipulation
+install.packages("tidyr") # Data tidying
+install.packages("ggplot2") # Data visualization
+install.packages("knitr") # Document generation
+
+# Install DemoKin
+# DemoKin is available on CRAN (https://cran.r-project.org/web/packages/DemoKin/index.html),
+# but we'll use the development version on GitHub (https://github.com/IvanWilli/DemoKin):
+install.packages("remotes")
+remotes::install_github("IvanWilli/DemoKin")
+library(DemoKin) # For kinship analysis
+```
+
+# Setting Up the Analysis Environment {#load-packages}
+
+Let's begin by loading the necessary packages for our analysis:
+
+```{r libraries, warning=F, message=FALSE}
+library(dplyr) # For data manipulation
+library(tidyr) # For restructuring data
+library(ggplot2) # For visualization
+library(knitr) # For document generation
+```
+
+# Understanding the Demographic Data {#demographic-data}
+
+## Data Overview
+
+The `DemoKin` package includes Swedish demographic data from the Human Mortality Database (HMD) and Human Fertility Database (HFD) as an example dataset. This includes:
+
+- **swe_px**: Age-by-year matrix of survival probabilities
+- **swe_Sx**: Age-by-year matrix of survival ratios
+- **swe_asfr**: Age-by-year matrix of fertility rates
+- **swe_pop**: Age-by-year matrix of population counts
+
+You can view all available data in the package with `data(package="DemoKin")`.
+
+## Exploring the Data
+
+Let's examine a subset of the Swedish demographic data to understand its structure:
+
+```{r data_exploration, warning=FALSE, message=FALSE}
+# First 5 rows and columns of survival probabilities
+head(swe_px[1:5, 1:5])
+
+# Fertility rates for ages 25-30
+head(swe_asfr[26:31, 1:10])
+```
+
+For our time-invariant model, we need to extract the demographic rates for a single year. Let's use 2015 as our reference year:
+
+```{r extract_2015, warning=FALSE, message=FALSE}
+# Extract vectors for 2015
+swe_surv_2015 <- swe_px[,"2015"] # Survival probabilities
+swe_asfr_2015 <- swe_asfr[,"2015"] # Fertility rates
+```
+
+Let's compare the data between different time periods to understand demographic changes. Here we compare values from 1950 and 2010:
+
+```{r compare_periods, warning=FALSE, message=FALSE}
+# Survival probabilities
+cat("Survival probabilities (px):\n")
+head(swe_px[,c("1950","2010")])
+
+# Fertility rates
+cat("\nFertility rates (asfr):\n")
+head(swe_asfr[,c("1950","2010")])
+
+# Population counts
+cat("\nPopulation counts:\n")
+head(swe_pop[,c("1950","2010")])
+```
+
+## Visualizing Demographic Trends
+
+### Mortality Trends
+
+Let's visualize how mortality has changed over time. We'll plot the probability of dying between ages $x$ and $x+1$ (denoted as $q_x = 1-p_x$) for different years:
+
+```{r mortality_viz}
+swe_px %>%
+ as.data.frame() %>%
+ mutate(age = c(0:100)) %>%
+ pivot_longer(cols = -c(age), names_to = "year", values_to = "px") %>%
+ filter(year %in% seq(1950, 2010, 30)) %>%
+ mutate(qx = 1-px) %>%
+ ggplot() +
+ geom_line(aes(x = age, y = qx, col = as.character(year)), linewidth = 1) +
+ scale_y_log10() +
+ labs(
+ title = "Age-specific mortality in Sweden (1950-2010)",
+ subtitle = "Probability of dying between ages x and x+1",
+ x = "Age",
+ y = "Probability of dying (qx, log scale)",
+ col = "Year"
+ ) +
+ theme_bw() +
+ theme(legend.position = "bottom")
+```
+
+**Interpretation**: This graph reveals how mortality has declined dramatically across all age groups from 1950 to 2010. The log scale highlights improvements at all ages, with particularly notable declines in infant and child mortality. The characteristic "bathtub" shape of human mortality is clearly visible: high mortality in infancy, followed by very low mortality through childhood and early adulthood, then a steady exponential increase with age.
+
+### Fertility Trends
+
+Now, let's examine how fertility patterns have changed over time:
+
+```{r fertility_viz}
+swe_asfr %>%
+ as.data.frame() %>%
+ mutate(age = c(0:100)) %>%
+ pivot_longer(cols = -c(age), names_to = "year", values_to = "fx") %>%
+ filter(year %in% seq(1950, 2010, 30)) %>%
+ ggplot() +
+ geom_line(aes(x = age, y = fx, col = as.character(year)), linewidth = 1) +
+ labs(
+ title = "Age-specific fertility in Sweden (1950-2010)",
+ subtitle = "Fertility rates by age of mother",
+ x = "Age of mother",
+ y = "Age-specific fertility rate (fx)",
+ col = "Year"
+ ) +
+ theme_bw() +
+ theme(legend.position = "bottom")
+```
+
+**Interpretation**: This visualization shows how fertility patterns have changed over the decades. The 1950 curve shows earlier childbearing with higher peak fertility rates. By 2010, fertility has shifted to later ages, reflecting the postponement of childbearing in developed countries. We can also observe the declining total fertility rate (the area under each curve).
+
+### Population Structure
+
+Finally, let's look at how the population structure has evolved:
+
+```{r population_viz}
+swe_pop %>%
+ as.data.frame() %>%
+ mutate(age = c(0:100)) %>%
+ pivot_longer(-age, names_to = "year", values_to = "pop") %>%
+ mutate(year = gsub("X", "", year)) %>%
+ filter(year %in% seq(1950, 2010, 30)) %>%
+ ggplot() +
+ geom_line(aes(x = age, y = pop, col = as.character(year)), linewidth = 1) +
+ labs(
+ title = "Female population structure in Sweden (1950-2010)",
+ subtitle = "Population counts by age",
+ x = "Age",
+ y = "Population count (thousands)",
+ col = "Year"
+ ) +
+ theme_bw() +
+ theme(legend.position = "bottom")
+```
+
+**Interpretation**: This graph shows how Sweden's female population structure has changed over time. The 1950 distribution shows the effects of baby booms and war years. By 2010, we see population aging with a more uniform distribution across ages and greater longevity, with significant numbers of women surviving to very old ages.
+
+# The DemoKin Package {#the-demokin-package}
+
+## Overview
+
+`DemoKin` is an R package designed to compute the number and age distribution of relatives (kin) of a focal individual under various demographic assumptions. It can analyze both living and deceased kin, and allows for both time-invariant and time-varying demographic rates.
+
+## The `kin()` Function {#kin-function}
+
+The main function in the package is `DemoKin::kin()`, which implements matrix kinship models to calculate expected kin counts.
+
+For our first example, we'll run the simplest model with the following assumptions:
+
+1. **Time-invariant** rates: The same set of mortality and fertility rates apply throughout all time periods (we'll use 2015 rates).
+2. **One-sex** population: We'll only use female data and trace kinship through female lines.
+
+Let's run the basic kinship model:
+
+```{r basic_kin_model}
+# Run the time-invariant, one-sex model
+swe_2015 <- kin(
+ p = swe_surv_2015, # Vector of survival probabilities
+ f = swe_asfr_2015, # Vector of fertility rates
+ time_invariant = TRUE # Use time-invariant model
+)
+```
+
+## Function Arguments {#kin-arguments}
+
+The `kin()` function accepts several important arguments:
+
+- **p**: A vector or matrix of survival probabilities with rows as ages (and columns as years if a matrix)
+- **f**: A vector or matrix of fertility rates with the same dimensions as p
+- **time_invariant**: Logical flag indicating whether to assume time-invariant rates (default: TRUE)
+- **output_kin**: Character vector specifying which kin types to return (e.g., "m" for mother, "d" for daughter)
+
+## Relative Types {#relative-types}
+
+In `DemoKin`, each type of relative is identified by a unique code. These codes differ from those used in Caswell [-@caswell_formal_2019]. The following table shows the relationship between these coding systems:
+
+```{r relative_codes}
+# Display relationship codes
+demokin_codes
+```
+
+## Function Output {#value}
+
+The `kin()` function returns a list containing two data frames:
+
+```{r output_structure}
+# Examine the structure of the output
+str(swe_2015)
+```
+
+### The `kin_full` Data Frame {#kin-full}
+
+This data frame contains detailed information on expected kin counts by:
+- Age of the focal individual
+- Type of kin
+- Age of kin
+- Living/dead status
+
+```{r kin_full_example}
+# View the first few rows of kin_full
+head(swe_2015$kin_full)
+```
+
+### The `kin_summary` Data Frame {#kin-summary}
+
+This data frame provides a summary of expected kin counts by:
+- Age of the focal individual
+- Type of kin
+- Total counts (not broken down by age of kin)
+
+```{r kin_summary_example}
+# View the first few rows of kin_summary
+head(swe_2015$kin_summary)
+```
+
+# Visualizing Kinship Networks {#kinship-diagrams}
+
+## Keyfitz Diagrams
+
+One powerful way to visualize kinship structure is through a network or 'Keyfitz' kinship diagram [@Keyfitz2005]. Let's see the expected number of living female relatives for a 65-year-old woman according to our model:
+
+```{r keyfitz_diagram, fig.height=10, fig.width=12}
+swe_2015$kin_summary %>%
+ filter(age_focal == 65) %>%
+ select(kin, count = count_living) %>%
+ plot_diagram(rounding = 2)
+```
+
+**Interpretation**: This Keyfitz diagram provides a comprehensive view of the kinship network for a 65-year-old woman in Sweden (based on 2015 demographic rates). The diagram shows:
+
+- Vertical relationships: A 65-year-old woman is likely to have around 0.9 daughters and 0.52 granddaughters through daughters, but few great-granddaughters (nearly 0) as they wouldn't have been born yet. Looking upward, she's unlikely to have a living mother (0.16) and almost certainly no living grandmother (nearly 0).
+- Horizontal relationships: She would have about 0.83 living sisters (0.38 old sisters and 0.45 younger sisters) and 0.8 nieces.
+
+This visualization helps us understand the changing composition of family networks across the life course.
+
+# Analyzing Living Kin Over the Life Course {#number-of-living-kin}
+
+Let's run the model again, but this time we'll specify exactly which kin types we want to analyze:
+
+```{r specific_kin_model}
+swe_2015 <-
+ kin(
+ p = swe_surv_2015,
+ f = swe_asfr_2015,
+ output_kin = c("c", "d", "gd", "ggd", "gm", "m", "n", "a", "s"), # Specific kin types
+ time_invariant = TRUE
+ )
+```
+
+Now, let's visualize how the expected number of each type of relative changes over the life course:
+
+```{r kin_over_lifecourse, fig.height=8, fig.width=10}
+swe_2015$kin_summary %>%
+ rename_kin() %>% # Convert kin codes to readable labels
+ ggplot() +
+ geom_line(aes(age_focal, count_living), linewidth = 1) +
+ theme_bw() +
+ labs(
+ title = "Expected number of living female relatives over the life course",
+ subtitle = "Based on Swedish demographic rates from 2015",
+ x = "Age of focal individual",
+ y = "Number of living female relatives"
+ ) +
+ facet_wrap(~kin_label, scales = "free_y") # Use different y-scales for each panel
+```
+
+**Interpretation**: These plots show how different kinship relationships evolve over a person's lifetime:
+
+- **Mothers**: Initially 1.0 (everyone has a mother at birth), then gradually declining as mortality takes its toll
+- **Grandmothers**: Start lower (many already deceased at Focal's birth) and decline rapidly
+- **Daughters**: Increasing during reproductive years, then stable
+- **Granddaughters**: Appearing later and increasing as daughters have children
+- **Great-granddaughters**: Appearing even later as granddaughters have children
+- **Sisters**: Relatively stable then declining due to mortality
+- **Aunts and cousins**: Follow similar patterns of eventual decline
+- **nieces**: similar patterns as daughters.
+
+> Note that we are working in a time-invariant framework. You can think of the results as analogous to life expectancy (i.e., expected years of life for a synthetic cohort experiencing a given set of period mortality rates).
+
+## Total Family Size Over the Life Course
+
+How does the overall family size (and family composition) vary over life for an average woman?
+
+```{r family_size_composition}
+# Calculate total kin count at each age
+counts <-
+ swe_2015$kin_summary %>%
+ group_by(age_focal) %>%
+ summarise(count_living = sum(count_living)) %>%
+ ungroup()
+
+# Plot family composition over the life course
+swe_2015$kin_summary %>%
+ select(age_focal, kin, count_living) %>%
+ rename_kin() %>%
+ ggplot(aes(x = age_focal, y = count_living)) +
+ geom_area(aes(fill = kin_label), color = "black", alpha = 0.8) +
+ geom_line(data = counts, linewidth = 1.5) +
+ labs(
+ title = "Family size and composition over the life course",
+ subtitle = "Based on Swedish demographic rates from 2015",
+ x = "Age of focal individual",
+ y = "Number of living female relatives",
+ fill = "Kin type"
+ ) +
+ theme_bw() +
+ theme(legend.position = "bottom")
+```
+
+**Interpretation**: This stacked area chart reveals fascinating patterns in family size and composition throughout life:
+
+1. **Early life**: Family consists primarily of mothers, grandmothers, aunts, cousins, and sisters
+2. **Young and middle adulthood (20s-40s)**: Total family size increases as daughters and nieces are born
+3. **Late adulthood and Older (50s+)**: Even though granddaughters and granddaughters are born, while older relatives (mothers, aunts, grandmothers) begin to disappear. Family composition shifts dramatically toward descendants (daughters, granddaughters, great-granddaughters)
+
+Therefore, the total family size (black line) shows an interesting U-shape, first declining as older relatives die, then rising again as new generations are born.
+
+# Age Distribution of Relatives {#age-distribution-of-living-kin}
+
+Beyond just counting relatives, we're often interested in their age distribution. Using the `kin_full` data frame, we can examine the age distribution of Focal's relatives at a specific age.
+
+Let's visualize the age distribution of relatives when Focal is 65 years old:
+
+```{r age_distribution, fig.height=8, fig.width=10}
+swe_2015$kin_full %>%
+ rename_kin() %>%
+ filter(age_focal == 65) %>%
+ ggplot(aes(age_kin, living)) +
+ geom_line(linewidth = 1) +
+ geom_vline(xintercept = 65, color = "red", linetype = "dashed") +
+ labs(
+ title = "Age distribution of living female relatives when Focal is 65",
+ subtitle = "Based on Swedish demographic rates from 2015 (red line = Focal's age)",
+ x = "Age of relative",
+ y = "Expected number of living relatives"
+ ) +
+ theme_bw() +
+ facet_wrap(~kin_label, scales = "free_y")
+```
+
+**Interpretation**: These distributions provide rich information about family age structure:
+
+- **Mothers**: If still alive, would be concentrated around age 85-95
+- **Daughters**: Mostly in their 30s and 40s
+- **Granddaughters**: Predominantly young, between ages 0-15
+- **Sisters**: Close to Focal's own age (65)
+- **Nieces**: Mostly in their 30s and 40s, similar to daughters
+- **Cousins**: Close to Focal's own age (65)
+
+Understanding age distributions is crucial for estimating care needs, support systems, and intergenerational transfers within families.
+
+# Conclusion
+
+In this tutorial, we've explored how to use the `DemoKin` package to model kinship dynamics in a time-invariant, one-sex framework. We've seen how different demographic patterns affect family size and composition, and visualized these relationships across the life course.
+
+Key insights include:
+
+1. Family networks are dynamic, changing dramatically throughout the life course
+2. Both family size and composition evolve with age
+3. Modern demographic rates lead to "bean pole" families—vertical extension (multiple generations) but horizontal contraction (fewer siblings, cousins)
+4. Matrix population models provide a powerful framework for understanding these dynamics
+
+# References
diff --git a/vignettes/1_2_OneSex_TimeVarying_Age.Rmd b/vignettes/1_2_OneSex_TimeVarying_Age.Rmd
new file mode 100644
index 0000000..2342a12
--- /dev/null
+++ b/vignettes/1_2_OneSex_TimeVarying_Age.Rmd
@@ -0,0 +1,309 @@
+---
+title: "One-sex time-varying kinship model specified by age"
+output:
+ html_document:
+ toc: true
+ toc_float:
+ collapsed: false
+ smooth_scroll: true
+ theme: readable
+ highlight: pygments
+ number_sections: true
+ code_folding: show
+ df_print: paged
+ fig_caption: true
+bibliography: references.bib
+vignette: >
+ %\VignetteIndexEntry{One-sex time-varying kinship model specified by age}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include=FALSE}
+# Set up code chunk options
+knitr::opts_chunk$set(echo = TRUE,
+ message = FALSE,
+ warning = FALSE,
+ fig.align = 'center',
+ fig.width = 8,
+ fig.height = 6,
+ dpi = 300)
+# Prevent scientific notation (useful for the rate calculation)
+options(scipen = 999999)
+pkgload::load_all()
+```
+
+
+
+
+Learning Objectives: In this vignette, you will learn how to extend the DemoKin time-invariant model to incorporate changing demographic rates over time. You will understand how to implement a time-varying kinship model, examine the impact of demographic change on kinship networks, and analyze related phenomena such as kin loss and prevalence of specific conditions among kin.
+
+
+# Introduction {#introduction}
+
+While the time-invariant model we explored in the previous vignette provides valuable insights into kinship structures, it has one significant limitation: it assumes demographic conditions remain constant throughout a person's life. In reality, mortality and fertility rates evolve dramatically over time due to socioeconomic development, medical advances, and cultural shifts.
+
+Time-varying kinship models address this limitation by incorporating historical demographic changes, offering a more nuanced and realistic picture of family networks. These advanced models allow us to:
+
+- Track kinship networks for specific birth cohorts across their life course
+- Account for the different demographic conditions experienced by each generation
+- Provide more accurate estimates of kin availability in specific historical periods
+- Better understand how demographic transitions shape family structures
+
+In this vignette, we will implement a **one-sex time-varying model**, outlined in Caswell and Song [-@caswell_formal_2021], using the `DemoKin` package. We build on the time-invariant approach but incorporate year-specific mortality and fertility rates to model the kinship networks of individuals born in specific years.
+
+## Package Installation {#preparation}
+
+If you haven't already installed the required packages from the previous vignette, here's what you'll need:
+
+```{r installs, eval=FALSE}
+# Install basic data analysis packages
+rm(list = ls())
+install.packages("dplyr") # Data manipulation
+install.packages("tidyr") # Data tidying
+install.packages("ggplot2") # Data visualization
+install.packages("knitr") # Document generation
+
+# Install DemoKin
+# DemoKin is available on CRAN (https://cran.r-project.org/web/packages/DemoKin/index.html),
+# but we'll use the development version on GitHub (https://github.com/IvanWilli/DemoKin):
+install.packages("remotes")
+remotes::install_github("IvanWilli/DemoKin")
+library(DemoKin) # For kinship analysis
+```
+
+# Setting Up the Analysis Environment {#load-packages}
+
+Let's load the necessary packages for our analysis:
+
+```{r libraries, warning=F, message=FALSE}
+library(dplyr) # For data manipulation
+library(tidyr) # For restructuring data
+library(ggplot2) # For visualization
+library(knitr) # For document generation
+```
+
+# Time-Varying Kinship Models {#time-varying-models}
+
+## The Conceptual Shift
+
+In the time-invariant model, we assumed that everyone experiences the same mortality and fertility rates throughout their lives (e.g., the 2015 rates). However, this is a simplification of reality. Demographic rates change over time, often dramatically:
+
+- A woman born in 1900 would have experienced very different mortality risks at age 20 (in 1920) than a woman born in 1950 would have at age 20 (in 1970)
+- Similarly, fertility patterns have shifted substantially over generations
+
+Time-varying models account for these historical changes by using year-specific demographic rates. They provide a more realistic picture of kinship dynamics for specific birth cohorts as they age through changing demographic conditions.
+
+## Data Requirements
+
+For time-varying models, instead of vectors of rates for a single year, we need:
+
+1. A matrix of survival probabilities, with:
+ - Rows representing ages (0, 1, 2, ..., 100+)
+ - Columns representing years (e.g., 1950, 1951, ..., 2020)
+
+2. A matrix of fertility rates with the same dimensions
+
+3. A matrix of population counts (optional, for certain calculations)
+
+The `DemoKin` package includes Swedish data in this format, which we'll use for our example.
+
+## Implementing the Time-Varying Model {#run-the-model-time-varying}
+
+Let's implement a time-varying kinship model for women born in 1960 in Sweden. We'll focus on specific kin types to make interpretation easier:
+
+```{r}
+swe_time_varying <-
+ kin(
+ p = swe_px, # Matrix of survival probabilities by age and year
+ f = swe_asfr, # Matrix of fertility rates by age and year
+ n = swe_pop, # Matrix of population counts by age and year
+ time_invariant = FALSE, # Use time-varying model
+ output_cohort = 1960, # Focus on the 1960 birth cohort
+ output_kin = c("d","gd","ggd","m","gm","ggm") # Select specific kin types
+ )
+```
+
+In this model:
+- We use the full matrices of Swedish demographic data (`swe_px`, `swe_asfr`, `swe_pop`)
+- We set `time_invariant = FALSE` to implement a time-varying model
+- We specify `output_cohort = 1960` to focus on women born in 1960
+- We select specific relatives to analyze (daughters, granddaughters, great-granddaughters, mothers, grandmothers, and great-grandmothers)
+
+## Living Relatives Across the Life Course {#living-relatives}
+
+Let's examine how the number of living kin changes throughout the life course for the 1960 birth cohort:
+
+```{r, fig.height=6, fig.width=8}
+swe_time_varying$kin_summary %>%
+ ggplot(aes(age_focal, count_living, color=factor(cohort))) +
+ scale_y_continuous(name = "", labels = seq(0,3,.2), breaks = seq(0,3,.2)) +
+ geom_line(color = 1) +
+ geom_vline(xintercept = 35, color=2) +
+ labs(
+ title = "Expected number of living relatives for the 1960 birth cohort",
+ subtitle = "Swedish demographic rates, time-varying model",
+ x = "Age of focal individual",
+ y = "Expected number of living relatives"
+ ) +
+ facet_wrap(~kin, scales = "free") +
+ theme_bw()
+```
+
+**Interpretation**: These plots show how the expected number of living relatives changes as the 1960 cohort ages:
+
+- **Mothers (m)**: Starts near 1.0 and gradually declines as mothers die
+- **Grandmothers (gm)**: Already well below 1.0 at birth, reflecting pre-1960 mortality, then declining rapidly
+- **Great-grandmothers (ggm)**: Very few at birth, quickly disappearing
+- **Daughters (d)**: Increasing during reproductive years, reflecting fertility patterns of the 1980s-2000s
+- **Granddaughters (gd)**: Appearing as daughters reach reproductive age, reflecting fertility of the 2000s-2030s
+- **Great-granddaughters (ggd)**: Beginning to appear in later years
+
+The red vertical line at age 35 provides a reference point to compare kin counts at a specific age. Unlike the time-invariant model, these counts reflect the actual historical demographic conditions experienced by this cohort and their relatives.
+
+## Analyzing Kin Loss {#kin-loss}
+
+Beyond counting living kin, we can also examine patterns of kin mortality. Understanding kin loss is important because it:
+
+- Has psychological and social consequences for bereaved individuals
+- Affects the availability of support and care across generations
+- Influences patterns of inheritance and resource transfers
+
+Let's examine the cumulative number of deceased relatives by age for our 1960 birth cohort:
+
+```{r, fig.height=6, fig.width=8, message=FALSE, warning=FALSE}
+swe_time_varying$kin_summary %>%
+ ggplot() +
+ geom_line(aes(age_focal, count_cum_dead)) +
+ labs(
+ title = "Cumulative number of deceased relatives by age",
+ subtitle = "1960 birth cohort, Sweden",
+ x = "Age of focal individual",
+ y = "Expected number of deceased relatives"
+ ) +
+ theme_bw() +
+ facet_wrap(~kin, scales="free")
+```
+
+**Interpretation**: These graphs show the cumulative number of deaths experienced by kin type:
+
+- **Ascending relatives**: Deaths accumulate gradually for mothers, and more rapidly for grandmothers and great-grandmothers
+- **Descending relatives**: Deaths are rare but do occur, representing the tragedy of losing children, grandchildren, or great-grandchildren
+
+We can also examine the mean age at which relatives die. For a 50-year-old woman born in 1960:
+
+```{r}
+swe_time_varying$kin_summary %>%
+ filter(age_focal == 50) %>%
+ select(kin, count_cum_dead, mean_age_lost) %>%
+ mutate_if(is.numeric, round, 2) %>%
+ kable()
+```
+
+This table shows both the expected number of deceased relatives and the mean age at which they died. For example, by age 50, a woman born in 1960 would have lost approximately 0.32 mothers and the age at which such women lost mother is around 37.83 years-old on average.
+
+## Prevalence Calculations {#prevelances}
+
+Beyond simple counts, we can combine kinship data with prevalence rates by age to estimate the number of kin with specific characteristics. This approach, based on the Sullivan Method, allows us to:
+
+- Estimate relatives with specific health conditions
+- Calculate working-age vs. dependent kin
+- Project care needs or support capacity within family networks
+
+Let's create a hypothetical prevalence vector that increases exponentially with age (which might represent a condition like dementia):
+
+```{r, message=FALSE, warning=FALSE, fig.height=6, fig.width=10}
+# Create a prevalence vector that increases exponentially with age
+swe_prevalence <-
+ tibble(
+ age_kin = unique(swe_time_varying$kin_full$age_kin),
+ prev = .005 * exp(.05 * age_kin) # Exponential increase with age
+ )
+
+# Combine with kinship data and calculate counts
+swe_time_varying$kin_full %>%
+ left_join(swe_prevalence) %>%
+ group_by(kin, age_focal, cohort) %>%
+ summarise(
+ prevalent = sum(living * prev), # Kin with the condition
+ no_prevalent = sum(living * (1-prev)) # Kin without the condition
+ ) %>%
+ pivot_longer(cols = prevalent:no_prevalent, names_to = "prevalence_state", values_to = "count") %>%
+ ggplot(aes(x=age_focal, y = count)) +
+ geom_area(aes(fill=prevalence_state)) +
+ labs(
+ title = "Expected number of relatives with and without the condition",
+ subtitle = "Based on age-specific prevalence rates",
+ x = "Age of focal individual",
+ y = "Number of living relatives",
+ fill = "Condition status"
+ ) +
+ facet_wrap(~kin) +
+ theme_bw()
+```
+
+**Interpretation**: The stacked area plots show the expected number of relatives with and without the hypothetical condition at each age of Focal:
+
+- For older relatives (mothers, grandmothers), the proportion with the condition increases as Focal ages, reflecting the age-related nature of the condition
+- For younger relatives (daughters, granddaughters), the prevalence remains low, consistent with the age pattern of the condition
+- We can see both the changing total number of relatives and the changing composition by condition status
+
+This approach can be extended to any age-specific prevalence, such as:
+
+- Health conditions (disability, chronic disease)
+- Employment status
+- Educational attainment
+- Living arrangements
+
+# Conclusion
+
+In this vignette, we've explored how to implement time-varying kinship models using the `DemoKin` package, expanding our analytical approach to incorporate historical demographic change.
+
+The time-varying approach offers several advantages over time-invariant models:
+1. **Historical accuracy**: It incorporates actual demographic changes rather than assuming constant rates
+2. **Cohort specificity**: It can model specific birth cohorts experiencing their unique demographic conditions
+3. **Period effects**: It captures major demographic events like wars, pandemics, or baby booms
+
+These methodological improvements allow us to uncover important substantive insights:
+
+- How demographic transitions reshape family structures across generations
+- The unique kinship experiences of different birth cohorts as they navigate through changing mortality and fertility regimes
+- How kin loss and bereavement patterns evolve in response to mortality improvements
+- The complex interplay between period and cohort effects in shaping family networks
+
+While time-varying models provide greater realism, time-invariant models still serve valuable purposes. They offer a simpler baseline for understanding kinship patterns, can project future kinship structures based on current demographic conditions, and require less data.
+
+# References
diff --git a/vignettes/1_3_TwoSex_TimeInvariant_Age.Rmd b/vignettes/1_3_TwoSex_TimeInvariant_Age.Rmd
new file mode 100644
index 0000000..6f949c1
--- /dev/null
+++ b/vignettes/1_3_TwoSex_TimeInvariant_Age.Rmd
@@ -0,0 +1,356 @@
+---
+title: "Two-sex time-invariant kinship model specified by age"
+output:
+ html_document:
+ toc: true
+ toc_float:
+ collapsed: false
+ smooth_scroll: true
+ theme: readable
+ highlight: pygments
+ number_sections: true
+ code_folding: show
+ df_print: paged
+ fig_caption: true
+bibliography: references.bib
+vignette: >
+ %\VignetteIndexEntry{Two-sex time-invariant kinship model specified by age}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include=FALSE}
+# Set up code chunk options
+knitr::opts_chunk$set(echo = TRUE,
+ message = FALSE,
+ warning = FALSE,
+ fig.align = 'center',
+ fig.width = 8,
+ fig.height = 6,
+ dpi = 300)
+# Prevent scientific notation (useful for the rate calculation)
+options(scipen = 999999)
+pkgload::load_all()
+```
+
+
+
+
+Learning Objectives: In this vignette, you will learn how to extend the one-sex kinship model to incorporate both male and female demographic rates. You will understand the implementation of two-sex matrix models, explore how sex-specific mortality and fertility patterns affect kinship structures, and analyze differences in kin availability by sex.
+
+
+# Introduction {#introduction}
+
+Demographic processes fundamental to kinship formation vary significantly between males and females. While one-sex models offer valuable insights into family structures, they overlook these sex differences, which can lead to incomplete understanding of kinship dynamics. Two-sex kinship models address this limitation by incorporating sex-specific demographic rates and tracing both male and female lineages.
+
+Key advantages of two-sex models include:
+
+- Accounting for sex differences in mortality
+- Incorporating sex-specific fertility patterns
+- Enabling analysis of kin availability by sex
+- Allowing for the exploration of sex ratios within kinship networks
+- Providing more realistic estimates of kin availability across the life course
+
+In this vignette, we will implement a **two-sex time-invariant kinship model**, outlined in Caswell [-@caswell_formal_2022], using the `DemoKin` package to understand how sex-specific demographic patterns shape family structures.
+
+## Package Installation {#preparation}
+
+If you haven't already installed the required packages from the previous vignettes, here's what you'll need:
+
+```{r installs, eval=FALSE}
+# Install basic data analysis packages
+install.packages("dplyr") # Data manipulation
+install.packages("tidyr") # Data tidying
+install.packages("ggplot2") # Data visualization
+install.packages("knitr") # Document generation
+
+# Install DemoKin
+# DemoKin is available on CRAN (https://cran.r-project.org/web/packages/DemoKin/index.html),
+# but we'll use the development version on GitHub (https://github.com/IvanWilli/DemoKin):
+install.packages("remotes")
+remotes::install_github("IvanWilli/DemoKin")
+library(DemoKin) # For kinship analysis
+```
+
+# Setting Up the Analysis Environment {#load-packages}
+
+Let's load the necessary packages for our analysis:
+
+```{r libraries, warning=F, message=FALSE}
+rm(list = ls())
+library(dplyr) # For data manipulation
+library(tidyr) # For restructuring data
+library(ggplot2) # For visualization
+library(knitr) # For document generation
+```
+
+# Two-Sex Kinship Modeling {#two-sex-model}
+
+## Understanding Sex Differences in Demographic Rates {#model-input-2sex}
+
+The first step in implementing a two-sex kinship model is to understand the sex differences in demographic rates. Human males and females exhibit distinct mortality and fertility patterns:
+
+1. **Mortality differences**: Males generally experience higher mortality rates at all ages, resulting in shorter life expectancy
+2. **Fertility differences**: Males often begin reproduction later and can continue reproducing at older ages
+
+These differences affect kinship structures in several important ways:
+
+- The availability of male versus female relatives (especially at older ages)
+- The timing of kin loss experiences (e.g., when fathers versus mothers die)
+- The number of descendants for male versus female individuals
+
+For our example, we'll use data from France (2012), which is included in the `DemoKin` package. Let's examine the sex-specific mortality and fertility rates:
+
+```{r sex_differences, fig.height= 8, fig.width= 10}
+# Extract sex-specific rates
+fra_fert_f <- fra_asfr_sex[,"ff"] # Female fertility rates
+fra_fert_m <- fra_asfr_sex[,"fm"] # Male fertility rates
+fra_surv_f <- fra_surv_sex[,"pf"] # Female survival probabilities
+fra_surv_m <- fra_surv_sex[,"pm"] # Male survival probabilities
+
+# Compare total fertility rates by sex
+cat("Difference in TFR (male - female):", sum(fra_fert_m) - sum(fra_fert_f))
+
+# Visualize sex differences in demographic rates
+data.frame(value = c(fra_fert_f, fra_fert_m, fra_surv_f, fra_surv_m),
+ age = rep(0:100, 4),
+ sex = rep(c(rep("f", 101), rep("m", 101)), 2),
+ risk = c(rep("fertility rate", 101 * 2), rep("survival probability", 101 * 2))) %>%
+ ggplot(aes(age, value, col=sex)) +
+ geom_line(linewidth = 1) +
+ labs(
+ title = "Sex-specific demographic rates in France (2012)",
+ x = "Age",
+ y = "Rate",
+ color = "Sex"
+ ) +
+ facet_wrap(~ risk, scales = "free_y") +
+ theme_bw()
+```
+
+**Interpretation**: The graphs reveal important sex differences in demographic rates:
+
+- **Fertility patterns**: While total fertility rates are nearly identical between males and females (difference of only 0.01), the age patterns differ substantially. Male fertility occurs at later ages and has a wider distribution, reflecting the tendency for men to father children at older ages compared to women.
+
+- **Survival probabilities**: Females have higher survival probabilities at most of adult and old ages. This pattern leads to sex imbalances in older populations and affects the availability of different types of relatives.
+
+These sex differences in demographic rates will shape kinship networks in ways that one-sex models cannot capture.
+
+## Implementing the Two-Sex Model {#run-model-2sex}
+
+We now introduce the function `kin2sex`, which extends the one-sex function `kin` to incorporate sex-specific rates. The key differences are:
+
+1. We need to provide both female and male demographic rates
+2. We must specify the sex of the focal individual
+3. We need to indicate the sex ratio at birth (proportion of births that are female)
+
+Let's implement a two-sex time-varying model for France:
+
+```{r two_sex_model}
+kin_result <- kin2sex(
+ pf = fra_surv_f, # Female survival probabilities
+ pm = fra_surv_m, # Male survival probabilities
+ ff = fra_fert_f, # Female fertility rates
+ fm = fra_fert_m, # Male fertility rates
+ time_invariant = TRUE, # Use time-invariant model
+ sex_focal = "f", # Focus on female focal individuals
+ birth_female = .5 # Proportion of births that are female
+)
+```
+
+The output of `kin2sex` is similar to that of `kin`, with an additional column `sex_kin` that specifies the sex of each relative.
+
+## Living Relatives by Sex {#living-relatives-by-sex}
+
+Let's examine how the number of living relatives differs by sex across the life course of a female focal individual:
+
+```{r living_by_sex, message=FALSE, warning=FALSE}
+# Group specific kin types and filter for key relationships
+kin_out <- kin_result$kin_summary %>%
+ mutate(kin = case_when(kin %in% c("ys", "os") ~ "s", # Siblings
+ kin %in% c("ya", "oa") ~ "a", # Aunts/uncles
+ TRUE ~ kin)) %>%
+ filter(kin %in% c("d", "m", "gm", "ggm", "s", "a")) # Select key relationships
+
+# Visualize living kin by sex
+kin_out %>%
+ group_by(kin, age_focal, sex_kin) %>%
+ summarise(count = sum(count_living)) %>%
+ ggplot(aes(age_focal, count, fill = sex_kin)) +
+ geom_area() +
+ labs(
+ title = "Expected number of living relatives by sex",
+ subtitle = "Female focal individual, France 2012",
+ x = "Age of focal individual",
+ y = "Number of living relatives",
+ fill = "Sex of relative"
+ ) +
+ theme_bw() +
+ facet_wrap(~kin, labeller = labeller(
+ kin = c("a" = "Aunts/Uncles", "d" = "Children",
+ "gm" = "Grandparents", "ggm" = "Great-grandparents",
+ "m" = "Parents", "s" = "Siblings")
+ ))
+```
+
+**Interpretation**: These stacked area plots reveal how the sex composition of living relatives changes across the life course:
+
+- **Parents (m)**: Fathers (blue) die earlier than mothers (red), leading to a predominance of mothers at older ages
+- **Grandparents (gm)**: Even at birth, grandmothers outnumber grandfathers due to mortality in the grandparental generation
+- **Great-grandparents (ggm)**: Shows an even stronger female predominance due to compounded mortality differences across generations
+- **Siblings (s)**: Brothers die earlier than sisters, leading to a higher proportion of sisters at older ages
+- **Children (d)**: Starts with an even sex ratio, with slight female predominance at older ages due to higher male mortality
+
+These patterns highlight the importance of accounting for sex differences in kinship models, especially when studying older populations.
+
+## Understanding Kinship Terminology in Two-Sex Models {#kinship-terminology}
+
+When using the `kin2sex` function, it's important to understand how relationship codes work:
+
+```{r terminology_note}
+# Example of how to identify specific relatives by sex
+kin_result$kin_summary %>%
+ filter(kin == "d", sex_kin == "m") %>% # This selects sons (male children)
+ head()
+```
+
+The function uses the same relationship codes as the one-sex model (see `demokin_codes()`), but now each relative has a specified sex. For example:
+
+- `kin = "d", sex_kin = "f"` refers to daughters
+- `kin = "d", sex_kin = "m"` refers to sons
+- `kin = "m", sex_kin = "f"` refers to mothers
+- `kin = "m", sex_kin = "m"` refers to fathers
+
+This coding system allows for flexible analysis of specific relative types while maintaining compatibility with the one-sex model.
+
+## Sex Ratios in Kinship Networks {#sex-ratios}
+
+Sex ratios (males per female) are a traditional measure in demography that can provide insights into kinship structures. Let's examine how sex ratios vary across different types of relatives:
+
+```{r sex_ratios, message=FALSE, warning=FALSE}
+# Calculate sex ratios (males per female) by kin type and age
+kin_out %>%
+ group_by(kin, age_focal) %>%
+ summarise(sex_ratio = sum(count_living[sex_kin == "m"], na.rm = TRUE) /
+ sum(count_living[sex_kin == "f"], na.rm = TRUE)) %>%
+ ggplot(aes(age_focal, sex_ratio)) +
+ geom_line(linewidth = 1) +
+ geom_hline(yintercept = 1, linetype = "dashed", color = "gray50") +
+ labs(
+ title = "Sex ratios of living relatives across the life course",
+ subtitle = "Males per female, France 2012",
+ x = "Age of focal individual",
+ y = "Sex ratio (m/f)"
+ ) +
+ theme_bw() +
+ facet_wrap(~kin, scales = "free", labeller = labeller(
+ kin = c("a" = "Aunts/Uncles", "d" = "Children",
+ "gm" = "Grandparents", "ggm" = "Great-grandparents",
+ "m" = "Parents", "s" = "Siblings")
+ ))
+```
+
+**Interpretation**: The sex ratio plots reveal several important patterns:
+
+- **Parents**: The sex ratio starts at 1 (equal numbers of mothers and fathers) but declines rapidly with age, reflecting higher male mortality
+- **Grandparents**: Even at birth, the sex ratio is below 1, with a 25-year-old having only about 0.5 grandfathers per grandmother
+- **Great-grandparents**: Shows even more extreme female predominance
+- **Children**: Maintains a sex ratio close to 1 throughout life, with slight declines at older ages
+- **Siblings**: Shows gradual decline in sex ratio with age due to higher male mortality
+
+These sex ratios have important implications for care relationships and support networks, particularly in older populations where female relatives predominate.
+
+## Timing of Kin Loss by Sex {#kin-loss-by-sex}
+
+The experience of losing relatives differs by the sex of those relatives. Let's examine how the timing of kin loss varies by sex:
+
+```{r kin_loss, message=FALSE, warning=FALSE}
+# Visualize dead kin by sex
+kin_out %>%
+ group_by(kin, sex_kin, age_focal) %>%
+ summarise(count = sum(count_dead)) %>%
+ ggplot(aes(age_focal, count, color = sex_kin)) +
+ geom_line(linewidth = 1) +
+ labs(
+ title = "Number of deceased relatives by sex",
+ subtitle = "Female focal individual, France 2012",
+ x = "Age of focal individual",
+ y = "Number of deceased relatives",
+ color = "Sex of relative"
+ ) +
+ theme_bw() +
+ facet_wrap(~kin, scales = "free", labeller = labeller(
+ kin = c("a" = "Aunts/Uncles", "d" = "Children",
+ "gm" = "Grandparents", "ggm" = "Great-grandparents",
+ "m" = "Parents", "s" = "Siblings")
+ ))
+```
+
+**Interpretation**: These curves show how the experience of losing relatives differs by sex:
+
+- **Parents**: The loss of fathers (blue) occurs earlier than the loss of mothers (red)
+- **Grandparents**: Grandfather are often lost before birth or early in life, while grandmothers tend to be lost later
+- **Siblings**: Brothers are lost at higher rates than sisters before old ages (75+)
+- **Children**: While rare, the loss of sons occurs at higher rates than daughters
+
+Understanding these patterns is important for studying bereavement experiences and their impacts across the life course.
+
+# Applications of Two-Sex Kinship Models
+
+Two-sex kinship models have numerous applications in demographic and social research:
+
+1. **Gender and care**: Women typically provide more informal care to relatives than men. Two-sex models can help quantify potential care burdens by examining the availability of different types of relatives by sex.
+
+2. **Kinship networks in aging societies**: As populations age, the sex composition of available kin changes dramatically. Two-sex models allow us to project these changes and their implications for social support.
+
+3. **Intergenerational transfers**: Resources often flow differently between male and female relatives. Two-sex models provide the demographic foundation for studying these gendered patterns.
+
+4. **Demographic transitions**: Sex differences in mortality and fertility change during demographic transitions, reshaping kinship networks in ways that one-sex models cannot capture.
+
+5. **Demographic shocks**: Events like wars often affect males and females differently, with long-lasting impacts on kinship structures. Two-sex models can capture these effects.
+
+# Conclusion
+
+In this vignette, we've explored how to implement two-sex kinship models using the `DemoKin` package. By incorporating sex-specific mortality and fertility rates, these models reveal important patterns that one-sex models cannot capture:
+
+1. Female predominance among older relatives due to sex differences in mortality
+2. Systematic differences in the timing of kin loss by sex, with male kin typically lost earlier
+3. Varying sex ratios within kinship networks by relationship type and age
+4. Distinct age distributions of relatives by sex
+
+These insights have significant implications for understanding care relationships, intergenerational transfers, and support systems in aging societies. The two-sex approach substantially enhances our understanding of how gender shapes family structures across the life course, providing a more realistic foundation for both research and policy development.
+
+# References
diff --git a/vignettes/1_4_TwoSex_TimeVarying_Age.Rmd b/vignettes/1_4_TwoSex_TimeVarying_Age.Rmd
new file mode 100644
index 0000000..da47edb
--- /dev/null
+++ b/vignettes/1_4_TwoSex_TimeVarying_Age.Rmd
@@ -0,0 +1,431 @@
+---
+title: "Two-sex time-varying kinship model specified by age"
+output:
+ html_document:
+ toc: true
+ toc_float:
+ collapsed: false
+ smooth_scroll: true
+ theme: readable
+ highlight: pygments
+ number_sections: true
+ code_folding: show
+ df_print: paged
+ fig_caption: true
+bibliography: references.bib
+vignette: >
+ %\VignetteIndexEntry{Two-sex time-varying kinship model specified by age}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include=FALSE}
+# Set up code chunk options
+knitr::opts_chunk$set(echo = TRUE,
+ message = FALSE,
+ warning = FALSE,
+ fig.align = 'center',
+ fig.width = 8,
+ fig.height = 6,
+ dpi = 300)
+# Prevent scientific notation (useful for the rate calculation)
+options(scipen = 999999)
+pkgload::load_all()
+```
+
+
+
+
+Learning Objectives: In this vignette, you will learn how to implement a kinship model that combines both two-sex and time-varying approaches. You will understand how to incorporate sex-specific demographic rates that change over time, analyze the effects of demographic transition on kinship structures by sex, and explore approximation methods when data is limited.
+
+
+# Introduction {#introduction}
+
+Family networks are shaped simultaneously by two fundamental forces: demographic differences between males and females, and historical changes in demographic rates over time. While previous vignettes have explored these dimensions separately, this vignette integrates them into a more comprehensive framework: a **two-sex time-varying kinship model**, outlined in Caswell [-@caswell_formal_2022], using the `kin2sex` function with `time_invariant = FALSE`.
+
+## Package Installation {#preparation}
+
+If you haven't already installed the required packages from the previous vignettes, here's what you'll need:
+
+```{r installs, eval=FALSE}
+# Install basic data analysis packages
+install.packages("dplyr") # Data manipulation
+install.packages("tidyr") # Data tidying
+install.packages("ggplot2") # Data visualization
+install.packages("knitr") # Document generation
+
+# Install DemoKin
+# DemoKin is available on CRAN (https://cran.r-project.org/web/packages/DemoKin/index.html),
+# but we'll use the development version on GitHub (https://github.com/IvanWilli/DemoKin):
+install.packages("remotes")
+remotes::install_github("IvanWilli/DemoKin")
+library(DemoKin) # For kinship analysis
+```
+
+# Setting Up the Analysis Environment {#load-packages}
+
+Let's load the necessary packages for our analysis:
+
+```{r libraries, warning=F, message=FALSE}
+rm(list = ls())
+library(dplyr) # For data manipulation
+library(tidyr) # For restructuring data
+library(ggplot2) # For visualization
+library(knitr) # For document generation
+```
+
+# Two-Sex Time-Varying Kinship Models {#model-overview}
+
+## Model Structure and Components
+
+The combined two-sex time-varying kinship model expands on previous models by requiring:
+
+1. **Sex-specific mortality rates over time**: How survival differs between males and females across historical periods
+2. **Sex-specific fertility rates over time**: How fertility patterns differ between males and females across historical periods
+3. **Sex ratio at birth**: The proportion of births that are female
+4. **Sex of the focal individual**: Whether we're analyzing male or female kinship networks
+
+# Data Preparation {#model-input-2sex-time-varying}
+
+For this vignette, we'll use Swedish demographic data from the `DemoKin` package. However, since the package only includes female fertility and mortality data over time, we'll create synthetic male rates for illustration purposes.
+
+In a real-world application, you would ideally use actual male rates. Here, we'll create male rates by applying transformations to the female rates:
+
+```{r}
+# Extract dimensions of the data
+years <- ncol(swe_px)
+ages <- nrow(swe_px)
+
+# Use female rates directly from the package
+swe_surv_f_matrix <- swe_px
+swe_fert_f_matrix <- swe_asfr
+
+# Create synthetic male rates
+# Male survival: Lower than female (raising to power 1.5 reduces values)
+swe_surv_m_matrix <- swe_px ^ 1.5 # artificial perturbation for this example
+
+# Male fertility: Shifted to slightly older ages and slightly higher
+swe_fert_m_matrix <- rbind(matrix(0, 5, years),
+ swe_asfr[-((ages-4):ages),]) * 1.05 # artificial perturbation for this example
+```
+
+Let's examine the resulting rates for a specific year (1900) to verify they follow expected patterns:
+
+```{r}
+bind_rows(
+ data.frame(age = 0:100, sex = "Female", component = "Fertility rate", value = swe_fert_f_matrix[,"1900"]),
+ data.frame(age = 0:100, sex = "Male", component = "Fertility rate", value = swe_fert_m_matrix[,"1900"]),
+ data.frame(age = 0:100, sex = "Female", component = "Survival probability", value = swe_surv_f_matrix[,"1900"]),
+ data.frame(age = 0:100, sex = "Male", component = "Survival probability", value = swe_surv_m_matrix[,"1900"])) %>%
+ ggplot(aes(age, value, col = sex)) +
+ geom_line() +
+ theme_bw() +
+ facet_wrap(~component, scales = "free") +
+ labs(
+ title = "Sex-specific demographic rates in Sweden (1900)",
+ x = "Age",
+ y = "Rate",
+ color = "Sex"
+ )
+```
+
+**Interpretation**: The plot confirms our synthetic rates follow expected patterns:
+
+- **Fertility**: Male fertility is shifted to slightly older ages compared to female fertility
+- **Survival**: Male survival probabilities are lower than female survival at all ages
+- **Both rates** show characteristic age patterns: fertility concentrated in reproductive ages, and survival declining with age
+
+# Running the Two-Sex Time-Varying Model {#run-model-2sex-time-varying}
+
+Now, let's implement the two-sex time-varying kinship model using the `kin2sex` function with `time_invariant = FALSE`:
+
+```{r}
+kin_out_time_varying <- kin2sex(
+ pf = swe_surv_f_matrix, # Female survival matrix (age x year)
+ pm = swe_surv_m_matrix, # Male survival matrix (age x year)
+ ff = swe_fert_f_matrix, # Female fertility matrix (age x year)
+ fm = swe_fert_m_matrix, # Male fertility matrix (age x year)
+ sex_focal = "f", # Focal individual is female
+ time_invariant = FALSE, # Use time-varying model
+ birth_female = .5, # Sex ratio at birth (50% female)
+ output_cohort = 1900 # Focus on the 1900 birth cohort
+)
+```
+
+The resulting output provides detailed information on the kinship network for the 1900 female birth cohort, with relatives classified by both age and sex.
+
+# Comparing Time-Varying and Time-Invariant Models {#kin-availability-2sex-time-varying}
+
+To understand the impact of incorporating historical demographic change, let's compare the time-varying model with a time-invariant model that uses only 1900 rates:
+
+```{r, message=FALSE, warning=FALSE}
+# Run a time-invariant model using only 1900 rates
+kin_out_time_invariant <- kin2sex(
+ pf = swe_surv_f_matrix[,"1900"], # Female survival (1900)
+ pm = swe_surv_m_matrix[,"1900"], # Male survival (1900)
+ ff = swe_fert_f_matrix[,"1900"], # Female fertility (1900)
+ fm = swe_fert_m_matrix[,"1900"], # Male fertility (1900)
+ sex_focal = "f", # Focal individual is female
+ birth_female = .5 # Sex ratio at birth (50% female)
+)
+
+# Combine and plot the results
+kin_out_time_varying$kin_summary %>%
+ filter(cohort == 1900) %>%
+ mutate(type = "variant") %>%
+ bind_rows(kin_out_time_invariant$kin_summary %>% mutate(type = "invariant")) %>%
+ # Combine siblings and aunts/uncles for simplicity
+ mutate(kin = case_when(kin %in% c("ys", "os") ~ "s",
+ kin %in% c("ya", "oa") ~ "a",
+ TRUE ~ kin)) %>%
+ # Select key relationships
+ filter(kin %in% c("d", "m", "gm", "ggm", "s", "a")) %>%
+ # Group by relationship type, age, sex, and model type
+ group_by(type, kin, age_focal, sex_kin) %>%
+ summarise(count = sum(count_living)) %>%
+ # Create plot
+ ggplot(aes(age_focal, count, linetype = type)) +
+ geom_line() +
+ theme_bw() +
+ facet_grid(cols = vars(kin), rows = vars(sex_kin), scales = "free") +
+ labs(
+ title = "Time-varying vs. time-invariant kinship models by sex",
+ subtitle = "Female 1900 birth cohort, Sweden",
+ x = "Age of focal individual",
+ y = "Number of living relatives",
+ linetype = "Model type"
+ )
+```
+
+**Interpretation**: This comparison reveals important differences between time-varying and time-invariant models:
+
+- **Relatives by sex**: The differences are pronounced for both male kin (bottom row) and female kin (top row), where mortality improvements over time led to greater availability than predicted by the time-invariant model
+- **Ascending generations**: For parents (m), grandparents (gm), and great-grandparents (ggm), the time-varying model shows higher kin availability at older ages, reflecting mortality improvements not captured by the time-invariant model
+- **Descendants**: For children (d), the time-varying model shows fewer kin, reflecting fertility decline over time
+- **Kin of same generation**: For siblings (s), fertility decline over time has limited impact on their numbers because these fertility events have either already occurred or will occur very shortly. Instead, mortality improvements play a more critical role, leading the time-varying model to predict a higher number of surviving siblings at older ages.
+
+The time-varying model captures the demographic transition that occurred over the 20th century, including declining fertility and mortality rates. This produces a more accurate representation of kinship dynamics for historical cohorts.
+
+# Approximation Methods for Limited Data {#approximations}
+
+In practice, demographic data is often limited, particularly for male fertility rates which can be difficult to obtain. Caswell [-@caswell_formal_2022] introduced two approximation methods to estimate two-sex kinship networks when male demographic rates are unavailable:
+
+1. **Androgynous approximation**: Assumes equal fertility and survival for males and females
+2. **GKP factors**: Applies multipliers to one-sex kin counts based on theoretical considerations in Goodman, Keyfitz and Pullum [-@caswell_formal_2022]
+
+Let's evaluate these approximations using French data from the `DemoKin` package:
+
+## Androgynous Approximation {#androgynous}
+
+The androgynous approximation uses female rates for both sexes. Let's compare it to the full two-sex model:
+
+```{r, message=FALSE, warning=FALSE}
+# Load data of France again
+fra_fert_f <- fra_asfr_sex[,"ff"] # Female fertility rates
+fra_fert_m <- fra_asfr_sex[,"fm"] # Male fertility rates
+fra_surv_f <- fra_surv_sex[,"pf"] # Female survival probabilities
+fra_surv_m <- fra_surv_sex[,"pm"] # Male survival probabilities
+
+# Full two-sex model
+kin_out <- kin2sex(fra_surv_f, fra_surv_m, fra_fert_f, fra_fert_m,
+ sex_focal = "f", birth_female = .5)
+
+# Androgynous approximation
+kin_out_androgynous <- kin2sex(fra_surv_f, fra_surv_f, fra_fert_f, fra_fert_f,
+ sex_focal = "f", birth_female = .5)
+
+# Compare the results
+bind_rows(
+ kin_out$kin_summary %>% mutate(type = "full"),
+ kin_out_androgynous$kin_summary %>% mutate(type = "androgynous")) %>%
+ group_by(kin, age_focal, sex_kin, type) %>%
+ summarise(count = sum(count_living)) %>%
+ ggplot(aes(age_focal, count, linetype = type)) +
+ geom_line() +
+ theme_bw() +
+ theme(legend.position = "bottom", axis.text.x = element_blank()) +
+ facet_grid(row = vars(sex_kin), col = vars(kin), scales = "free") +
+ labs(
+ title = "Androgynous approximation vs. full two-sex model",
+ subtitle = "France, 2012",
+ x = "Age of focal individual",
+ y = "Number of living relatives",
+ linetype = "Model type"
+ )
+```
+
+**Interpretation**: The androgynous approximation performs well for most kin types, particularly for female relatives. However, it shows noticeable discrepancies for most types of male relatives, where ignoring male-specific mortality leads to overestimation.
+
+## GKP Factors Approximation {#gkp}
+
+The GKP factors approach applies theoretical multipliers to one-sex kin counts. Let's implement and evaluate this approach:
+
+```{r, message=FALSE, warning=FALSE}
+# One-sex model
+kin_out_1sex <- kin(fra_surv_f, fra_fert_f, birth_female = .5)
+
+# Apply GKP factors
+kin_out_GKP <- kin_out_1sex$kin_summary %>%
+ mutate(count_living = case_when(
+ kin == "m" ~ count_living * 2, # Parents: multiply by 2
+ kin == "gm" ~ count_living * 4, # Grandparents: multiply by 4
+ kin == "ggm" ~ count_living * 8, # Great-grandparents: multiply by 8
+ kin == "d" ~ count_living * 2, # Children: multiply by 2
+ kin == "gd" ~ count_living * 4, # Grandchildren: multiply by 4
+ kin == "ggd" ~ count_living * 4, # Great-grandchildren: multiply by 4
+ kin == "oa" ~ count_living * 4, # Older aunts/uncles: multiply by 4
+ kin == "ya" ~ count_living * 4, # Younger aunts/uncles: multiply by 4
+ kin == "os" ~ count_living * 2, # Older siblings: multiply by 2
+ kin == "ys" ~ count_living * 2, # Younger siblings: multiply by 2
+ kin == "coa" ~ count_living * 8, # Cousins (older): multiply by 8
+ kin == "cya" ~ count_living * 8, # Cousins (younger): multiply by 8
+ kin == "nos" ~ count_living * 4, # Nieces/nephews (older): multiply by 4
+ kin == "nys" ~ count_living * 4 # Nieces/nephews (younger): multiply by 4
+ ))
+
+# Compare approaches at selected ages
+bind_rows(
+ kin_out$kin_summary %>% mutate(type = "full"),
+ kin_out_androgynous$kin_summary %>% mutate(type = "androgynous"),
+ kin_out_GKP %>% mutate(type = "gkp")) %>%
+ # Combine siblings, aunts/uncles, cousins, and nieces/nephews
+ mutate(kin = case_when(
+ kin %in% c("ys", "os") ~ "s", # All siblings
+ kin %in% c("ya", "oa") ~ "a", # All aunts/uncles
+ kin %in% c("coa", "cya") ~ "c", # All cousins
+ kin %in% c("nys", "nos") ~ "n", # All nieces/nephews
+ TRUE ~ kin)) %>%
+ # Select specific ages for comparison
+ filter(age_focal %in% c(5, 15, 30, 60, 80)) %>%
+ # Sum across sex for total kin counts
+ group_by(kin, age_focal, type) %>%
+ summarise(count = sum(count_living)) %>%
+ # Create bar chart
+ ggplot(aes(type, count)) +
+ geom_bar(aes(fill = type), stat = "identity") +
+ theme_bw() +
+ theme(axis.text.x = element_text(angle = 90), legend.position = "bottom") +
+ facet_grid(col = vars(kin), row = vars(age_focal), scales = "free") +
+ labs(
+ title = "Comparison of approximation methods with full two-sex model",
+ subtitle = "France, 2012, at selected ages",
+ x = "Approximation method",
+ y = "Total number of living relatives",
+ fill = "Method"
+ )
+```
+
+**Interpretation**: This comparison shows that both approximation methods produce reasonable estimates for most kin types. Overall, these approximations offer practical alternatives when sex-specific data is limited, though they should be used with caution and their limitations understood.
+
+# Incorporating Causes of Death {#prevalance-2sex-time-varying}
+
+The `kin2sex` function also allows for the analysis of kinship networks by cause of death, providing insights into how different mortality causes affect kin availability. More details about kin bereavement methodology can be found in Caswell, Margolis and Verdery [-@Caswell2023]. Let's implement a simple cause-of-death model with two competing causes.
+
+Now assume we have two causes of death (COD). For females, the risk of the first COD is half the risk of the second COD for ages greater than 50. For males, the risk of the first COD is 2/3 of the second COD for ages greater than 50. We operationalize this using two matrices with dimension 2 by 101 (number of causes by number of ages).
+
+```{r}
+# Create matrices of relative risks by cause, sex, and age
+Hf <- matrix(c(.5, 1), nrow = 2, ncol = length(fra_surv_f)) # Female risk factors
+Hm <- matrix(c(.33, 1), nrow = 2, ncol = length(fra_surv_f)) # Male risk factors
+
+# Set equal risks for ages below 50
+Hf[,1:50] <- Hm[,1:50] <- 1
+```
+
+Now we'll run the two-sex model with cause of death information:
+
+```{r}
+kin_out_cod_invariant <- kin2sex(
+ pf = fra_surv_f, # Female survival
+ pm = fra_surv_m, # Male survival
+ ff = fra_fert_f, # Female fertility
+ fm = fra_fert_m, # Male fertility
+ Hf = Hf, # Female cause-specific risk factors
+ Hm = Hm, # Male cause-specific risk factors
+ time_invariant = TRUE # Using time-invariant model for simplicity
+)
+```
+
+Let's examine the structure of the output:
+
+```{r}
+head(kin_out_cod_invariant)
+```
+
+The output now includes additional columns for each cause of death. Let's visualize the distribution of parental deaths by cause, sex, and age for a 30-year-old Focal:
+
+```{r}
+kin_out_cod_invariant %>%
+ filter(kin == "m", age_focal == 30) %>%
+ summarise(deadcause1 = sum(deadcause1),
+ deadcause2 = sum(deadcause2), .by = c(age_kin, sex_kin)) %>%
+ pivot_longer(deadcause1:deadcause2) %>%
+ ggplot(aes(age_kin, value, col = sex_kin, linetype = name)) +
+ geom_line() +
+ labs(
+ title = "Distribution of parental deaths by cause, sex, and age",
+ subtitle = "For a 30-year-old focal individual",
+ x = "Age of parent at death",
+ y = "Expected number of parental deaths",
+ color = "Sex of parent",
+ linetype = "Cause of death"
+ ) +
+ theme_bw()
+```
+
+**Interpretation**: This visualization shows the distribution of parental deaths by cause:
+
+- **Timing**: In this simplified example, all parental deaths occur after age 50
+- **Sex differences**: Male parents (fathers) show higher death counts at earlier ages, reflecting their higher mortality
+- **Cause differences**: The relative importance of different causes varies by sex, with males showing a different distribution than females
+
+This approach can be extended to include more causes of death and to incorporate time-varying cause-specific mortality, though this would require more complex data inputs.
+
+# Conclusion
+
+In this vignette, we've explored how to implement two-sex time-varying kinship models using the `DemoKin` package. These models provide a more comprehensive framework for understanding kinship dynamics by incorporating both sex differences and historical demographic change.
+
+Key insights include:
+
+1. Time-varying models capture the effects of demographic transition on kinship networks
+2. Sex-specific models reveal important differences in the availability of male versus female relatives
+3. Approximation methods offer practical alternatives when data is limited
+4. Cause-of-death extensions provide insights into how different mortality causes shape kinship structures
+
+These advanced models enhance our understanding of gender and family dynamics across demographic transitions, offering valuable tools for demographic analysis, care planning, and social policy development in aging societies.
+
+# References
+
diff --git a/vignettes/2_1_OneSex_TimeInvariant_AgeStage.Rmd b/vignettes/2_1_OneSex_TimeInvariant_AgeStage.Rmd
new file mode 100644
index 0000000..a8c6ee9
--- /dev/null
+++ b/vignettes/2_1_OneSex_TimeInvariant_AgeStage.Rmd
@@ -0,0 +1,311 @@
+---
+title: "One-sex time-invariant kinship model specified by age and stage"
+output:
+ html_document:
+ toc: true
+ toc_float:
+ collapsed: false
+ smooth_scroll: true
+ theme: readable
+ highlight: pygments
+ number_sections: true
+ code_folding: show
+ df_print: paged
+ fig_caption: true
+bibliography: references.bib
+vignette: >
+ %\VignetteIndexEntry{One-sex time-invariant kinship model specified by age and stage}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include=FALSE}
+# Set up code chunk options
+knitr::opts_chunk$set(echo = TRUE,
+ message = FALSE,
+ warning = FALSE,
+ fig.align = 'center',
+ fig.width = 8,
+ fig.height = 6,
+ dpi = 300)
+# Prevent scientific notation (useful for the rate calculation)
+options(scipen = 999999)
+pkgload::load_all()
+```
+
+
+
+
+Learning Objectives: In this vignette, you will learn how to extend the one-sex kinship model to incorporate stages alongside age. You will understand the implementation of multi-state matrix models, explore how demographic processes can vary by stage (e.g., parity), and analyze how these additional dimensions affect kinship structures.
+
+
+# Introduction {#introduction}
+
+In previous vignettes, we explored kinship models where individuals were classified only by age. However, demographic processes are often influenced by other characteristics beyond age. For example, mortality and fertility rates may vary by marital status, education level, health condition, parity (number of children already born), or other socioeconomic factors.
+
+Multi-state kinship models address this limitation by incorporating both age and stage (additional states) in the analysis. These models allow us to:
+
+- Account for heterogeneity in mortality and fertility by stage
+- Track changes in stage over the life course (e.g., transitions between parity states)
+- Analyze kin availability by both age and stage
+- Understand how stage-specific demographic patterns shape family structures
+- Provide more nuanced estimates of kinship dynamics
+
+In this vignette, we will start from a simple model, **one-sex time-invariant multi-state kinship model**, outlined in Caswell [-@caswell_formal_2020], using the `DemoKin` package. We'll focus specifically on parity as our stage variable, which allows us to analyze how fertility history affects kinship networks.
+
+## Package Installation {#preparation}
+
+If you haven't already installed the required packages from the previous vignettes, here's what you'll need:
+
+```{r installs, eval=FALSE}
+# Install basic data analysis packages
+install.packages("dplyr") # Data manipulation
+install.packages("tidyr") # Data tidying
+install.packages("ggplot2") # Data visualization
+install.packages("knitr") # Document generation
+
+# Install DemoKin
+# DemoKin is available on CRAN (https://cran.r-project.org/web/packages/DemoKin/index.html),
+# but we'll use the development version on GitHub (https://github.com/IvanWilli/DemoKin):
+install.packages("remotes")
+remotes::install_github("IvanWilli/DemoKin")
+library(DemoKin) # For kinship analysis
+```
+
+# Setting Up the Analysis Environment {#load-packages}
+
+Let's load the necessary packages for our analysis:
+
+```{r libraries, warning=F, message=FALSE}
+rm(list = ls())
+library(dplyr) # For data manipulation
+library(tidyr) # For restructuring data
+library(ggplot2) # For visualization
+library(knitr) # For document generation
+```
+
+# Multi-State Kinship Models {#multi-state-models}
+
+## Understanding Stage-Structured Models {#understanding-stage-models}
+
+In traditional age-structured models, an individual's demographic rates depend only on their age. In multi-state models, we expand this framework to consider both age and stage, where "stage" represents another characteristic that influences demographic processes.
+
+Key components of multi-state models include:
+
+1. **Age-and-stage-specific mortality rates**: How survival probabilities vary by both age and stage
+2. **Age-and-stage-specific fertility rates**: How fertility varies by both age and stage
+3. **Age-specific transition probabilities**: How individuals move between stages at each age
+
+These components allow us to build more realistic models of population dynamics and kinship networks by accounting for heterogeneity beyond age.
+
+## Parity as a Stage Variable {#parity-models}
+
+In this vignette, we'll focus on **parity** (the number of children already born to a woman) as our stage variable. Parity is particularly relevant for kinship studies because:
+
+- Fertility rates often vary substantially by parity
+- A woman's ultimate family size affects her kinship network
+- Parity transitions follow clear rules (can only increase by integer values)
+- Parity status can influence other demographic processes like mortality
+
+The `DemoKin` package includes data from Slovakia in 1980, which we'll use to implement a parity-based kinship model.
+
+## Understanding the Data Structure {#data-structure}
+
+For multi-state models, we need several matrices that specify how demographic rates vary by both age and stage. Let's examine the structure of the Slovakia data included in the `DemoKin` package:
+
+```{r data_structure}
+# Examine fertility rates by age and parity
+head(svk_fxs[1:5, ])
+
+# Examine survival probabilities by age and parity
+head(svk_pxs[1:5, ])
+
+# Examine birth matrix (where newborns enter the population)
+head(svk_Hxs[1:5, ])
+
+# Look at the structure of the transition matrices
+typeof(svk_Uxs)
+length(svk_Uxs)
+svk_Uxs[[20]] # Transition matrix for age 20
+```
+
+In this dataset:
+
+- `svk_fxs` is a data frame of fertility rates by age (rows) and parity stage (columns)
+- `svk_pxs` contains survival probabilities by age and parity
+- `svk_Hxs` specifies where newborns enter the population (in this case, at parity 0)
+- `svk_Uxs` is a list of matrices, one for each age, containing the probabilities of transitioning between parity states conditional on survival
+
+For parity, the stages represent:
+
+- Stage 1: Parity 0 (no children)
+- Stage 2: Parity 1 (one child)
+- Stage 3: Parity 2 (two children)
+- Stage 4: Parity 3 (three children)
+- Stage 5: Parity 4 (four children)
+- Stage 6: Parity 5+ (five or more children)
+
+Let's examine the transition matrix for a woman of reproductive age to understand how women move between parity states:
+
+```{r transition_matrix}
+# Display the transition matrix for age 25
+# This shows probabilities of moving between parity states
+svk_Uxs[[25]]
+```
+
+This matrix shows the probabilities of moving from one parity state (columns) to another (rows) for a 25-year-old woman, conditional on survival. Some key observations:
+
+- The matrix shows transitions from column j (starting parity) to row i (ending parity)
+- The diagonal elements represent the probability of remaining in the same parity state
+- Non-zero values appear only in the lower-triangular portion because parity can only increase (women can't "un-have" children)
+- Women at higher parities generally have lower probabilities of having another child
+
+# Implementing the Multi-State Model {#run-model-multi-state}
+
+Now let's implement the multi-state kinship model using the `kin_multi_stage` function:
+
+```{r}
+# Use birth_female=1 because fertility is for females only
+demokin_svk1980_caswell2020 <-
+ kin_multi_stage(
+ U = svk_Uxs, # List of transition matrices
+ f = svk_fxs, # Fertility rates by age and parity
+ D = svk_pxs, # Survival probabilities by age and parity
+ H = svk_Hxs, # Birth matrix
+ birth_female = 1, # All births are female (one-sex model)
+ parity = TRUE # Stages represent parity states
+ )
+```
+
+This function computes the joint age-parity distribution of kin for a focal individual under the specified demographic conditions. The output includes information on both the age and parity state of each relative.
+
+# Analyzing Age and Parity Distributions {#age-and-parity-distribution}
+
+Let's examine how both age and parity are distributed among relatives. First, we'll look at the age-parity distribution of aunts when the focal individual is 20 and 60 years old:
+
+```{r, message=FALSE, warning=FALSE, fig.height=6, fig.width=10}
+demokin_svk1980_caswell2020 %>%
+ filter(kin %in% c("oa","ya"), age_focal %in% c(20,60)) %>%
+ mutate(parity = as.integer(stage_kin)-1,
+ parity = case_when(parity == 5 ~ "5+", TRUE ~ as.character(parity))
+ ) %>%
+ group_by(age_focal, age_kin, parity) %>%
+ summarise(count = sum(living)) %>%
+ ggplot() +
+ geom_bar(aes(x = age_kin, y = count, fill = parity), stat = "identity") +
+ geom_vline(aes(xintercept = age_focal), col = 2) +
+ labs(
+ title = "Age and parity distribution of aunts",
+ subtitle = "Slovakia, 1980",
+ x = "Age of aunt",
+ y = "Number of aunts",
+ fill = "Parity"
+ ) +
+ theme_bw() +
+ facet_wrap(~age_focal, nrow = 2, labeller = labeller(
+ age_focal = c("20" = "Focal age: 20", "60" = "Focal age: 60")
+ ))
+```
+
+**Interpretation**: These bar charts show the joint distribution of age and parity for aunts at two different focal ages:
+
+- **When Focal is 20** (upper panel): Aunts are mostly middle-aged (30s-50s) and concentrated in parities 2-3, reflecting the fertility patterns of that generation
+- **When Focal is 60** (lower panel): Aunts are much older (if still alive) and show a similar parity distribution, though with more high-parity individuals due to the fertility patterns of earlier cohorts
+
+The red vertical line indicates Focal's age, providing a reference point for comparing the ages of relatives. This joint distribution provides richer information than looking at age or parity alone.
+
+# Kin Counts by Parity Over the Life Course {#kin-by-parity}
+
+Now let's examine how the parity distribution of different types of relatives changes over Focal's life course. We'll focus on daughters and mothers:
+
+```{r, message=FALSE, warning=FALSE, fig.height=6, fig.width=10}
+demokin_svk1980_caswell2020 %>%
+ filter(kin %in% c("d","m")) %>%
+ mutate(parity = as.integer(stage_kin)-1,
+ parity = case_when(parity == 5 ~ "5+", TRUE ~ as.character(parity))) %>%
+ group_by(age_focal, kin, parity) %>%
+ summarise(count = sum(living)) %>%
+ DemoKin::rename_kin() %>%
+ ggplot() +
+ geom_bar(aes(x = age_focal, y = count, fill = parity), stat = "identity") +
+ labs(
+ title = "Parity distribution of mothers and daughters over the life course",
+ subtitle = "Slovakia, 1980",
+ x = "Age of focal individual",
+ y = "Number of relatives",
+ fill = "Parity"
+ ) +
+ theme_bw() +
+ facet_wrap(~kin_label, nrow = 2)
+```
+
+**Interpretation**: These stacked bar charts reveal how the parity distribution of mothers and daughters evolves across Focal's life course:
+
+- **Mothers**:
+ - Most mothers are in parity 2-3, reflecting the dominant family size in this population
+ - At Focal's birth (age 0), mothers are necessarily at parity 1 or higher (as they must have at least one child - the Focal individual)
+ - The mothers' parity distribution shows a gradual shift toward higher parities when Focal is young, as some mothers continue to have additional children
+ - The composition is relatively stable after Focal reaches adulthood, with slight changes due to differential mortality by parity
+
+- **Daughters**:
+ - Initially all daughters are in parity 0 (childless)
+ - As Focal ages, daughters transition to higher parity states
+ - By the time Focal reaches old age, the parity distribution of daughters resembles the overall population pattern
+ - The total number increases until Focal's reproductive years end, then remains stable
+
+These patterns highlight the intergenerational transmission of fertility behaviors and how demographic patterns ripple through kinship networks.
+
+# Conclusion
+
+In this vignette, we've explored how to implement one-sex time-invariant multi-state kinship models using the `DemoKin` package. By incorporating both age and stage (parity) in our analysis, we've gained richer insights into the structure of kinship networks than would be possible with age alone.
+
+Key insights include:
+
+1. Demographic processes vary not only by age but also by other characteristics like parity
+2. Multi-state models allow us to track the joint distribution of age and stage among relatives
+3. The parity distribution of relatives evolves in complex ways over the life course
+4. Stage transitions (e.g., between parity states) are a key component of kinship dynamics
+
+While we focused on parity in this vignette, the `kin_multi_stage` function can be used for any state variable by setting the parameter `parity = FALSE` (the default). This flexibility opens up numerous applications:
+
+1. **Health status transitions**: Analyzing how health conditions affect and are affected by kinship networks
+2. **Educational attainment**: Exploring how education levels influence family formation and structure
+3. **Marital status**: Incorporating marriage, divorce, and widowhood into kinship dynamics
+4. **Geographical location**: Modeling proximity and migration within kinship networks
+5. **Labor force participation**: Understanding how work patterns interact with family structures
+
+# References
+
diff --git a/vignettes/2_2_TwoSex_TimeVarying_AgeStage.Rmd b/vignettes/2_2_TwoSex_TimeVarying_AgeStage.Rmd
new file mode 100644
index 0000000..552f9ab
--- /dev/null
+++ b/vignettes/2_2_TwoSex_TimeVarying_AgeStage.Rmd
@@ -0,0 +1,657 @@
+---
+title: "Two-sex time-varying kinship model specified by age and stage"
+output:
+ html_document:
+ toc: true
+ toc_float:
+ collapsed: false
+ smooth_scroll: true
+ theme: readable
+ highlight: pygments
+ number_sections: true
+ code_folding: show
+ df_print: paged
+ fig_caption: true
+bibliography: references.bib
+vignette: >
+ %\VignetteIndexEntry{Two-sex time-varying kinship model specified by age and stage}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include=FALSE}
+# Set up code chunk options
+knitr::opts_chunk$set(echo = TRUE,
+ message = FALSE,
+ warning = FALSE,
+ fig.align = 'center',
+ fig.width = 8,
+ fig.height = 6,
+ dpi = 300)
+# Prevent scientific notation (useful for the rate calculation)
+options(scipen = 999999)
+pkgload::load_all()
+```
+
+
+
+
+Learning Objectives: In this vignette, you will learn how to implement a kinship model that combines both two-sex and time-varying approaches with multiple stages. You will understand how to incorporate sex-specific demographic rates that change over time, analyze the effects of demographic transitions on kinship structures by sex and stage, and explore applications with different stage variables such as parity and education.
+
+
+# Introduction {#introduction}
+
+In this final vignette, we integrate all elements from previous tutorials into the most comprehensive kinship model available: a **two-sex time-varying multi-state model**. This framework simultaneously accounts for:
+
+- Sex differences in demographic rates
+- Historical changes over time
+- Stage-based transitions (like parity or education)
+- Joint distributions of age, sex, and stage among relatives
+
+
+
+Building on previous Caswell and colleagues' theoretical developments [-@caswell_formal_2019; -@caswell_formal_2020; -@caswell_formal_2021; -@caswell_formal_2022], Butterick and others [-@Butterick2025] created an integral approach providing unprecedented analytical power for understanding complex family structures. We'll apply this comprehensive model using the `kin_multi_stage_time_variant_2sex` function, exploring two examples: one using parity and another using educational attainment to demonstrate how these models illuminate contemporary family dynamics in ways simpler models cannot.
+
+## Package Installation {#preparation}
+
+If you haven't already installed the required packages from the previous vignettes, here's what you'll need:
+
+```{r installs, eval=FALSE}
+# Install basic data analysis packages
+install.packages("dplyr") # Data manipulation
+install.packages("tidyr") # Data tidying
+install.packages("ggplot2") # Data visualization
+install.packages("knitr") # Document generation
+install.packages("Matrix") # Matrix operations
+
+# Install DemoKin
+# DemoKin is available on CRAN (https://cran.r-project.org/web/packages/DemoKin/index.html),
+# but we'll use the development version on GitHub (https://github.com/IvanWilli/DemoKin):
+install.packages("remotes")
+remotes::install_github("IvanWilli/DemoKin")
+library(DemoKin)
+```
+
+# Setting Up the Analysis Environment {#load-packages}
+
+Let's load the necessary packages for our analysis:
+
+```{r libraries, warning=F, message=FALSE}
+rm(list = ls())
+library(dplyr) # For data manipulation
+library(tidyr) # For restructuring data
+library(ggplot2) # For visualization
+library(knitr) # For document generation
+library(Matrix) # For matrix operations
+options(dplyr.summarise.inform = FALSE) # hide summarise output
+```
+
+# Two-Sex Time-Varying Multi-State Models {#two-sex-time-varying-multi-state}
+
+The `kin_multi_stage_time_variant_2sex` function in the `DemoKin` package allows us to implement a comprehensive kinship model that accounts for sex, time, and stage simultaneously. This function computes stage-specific kinship networks across both sexes for an average member of a population (focal) under time-varying demographic rates.
+
+The model estimates:
+
+- The number of relatives of each type
+- The age distribution of relatives
+- The sex distribution of relatives
+- The stage distribution of relatives
+- How these distributions change over the life course of Focal
+- How they vary by Focal's birth cohort
+
+## Model Components and Requirements {#model-requirements}
+
+The two-sex time-varying multi-state model requires several inputs:
+
+1. **Sex-specific mortality rates by stage over time**: How survival probabilities differ between males and females of different stages across historical periods
+2. **Sex-specific fertility rates by stage over time**: How fertility patterns differ between males and females of different stages across historical periods
+3. **Sex-specific transition rates between stages over time**: How individuals move between stages at each age, potentially differing by sex
+4. **Sex ratio at birth**: The proportion of births that are female
+5. **Birth redistribution matrices**: How newborns are distributed across stages
+6. **Sex and initial stage of the focal individual**: The characteristics of the person whose kin network we're analyzing
+
+In the following sections, we'll explore two examples of this model using different stage variables: parity and education.
+
+# Example 1: Parity as the Stage Variable {#parity-as-stage}
+
+## Data Preparation {#parity-data-preparation}
+
+In our first example, we'll use parity (number of children already born) as our stage variable. We'll use data from the United Kingdom ranging from 1965 to 2022, sourced from the Human Mortality Database and the Office for National Statistics.
+
+Due to data limitations, we make some simplifying assumptions:
+
+1. Fertility rates vary with time and parity but are the same across sexes (the "androgynous approximation")
+2. Mortality rates vary with time and sex but are the same across parity classes
+3. Parity progression probabilities vary with time but are the same across sexes
+
+Let's load the pre-processed UK data:
+
+```{r parity_data_load, message=FALSE, warning=FALSE}
+# Load pre-processed data for UK
+F_mat_fem <- Female_parity_fert_list_UK # Female fertility by parity
+F_mat_male <- Female_parity_fert_list_UK # Male fertility (same as female due to androgynous approximation)
+T_mat_fem <- Parity_transfers_by_age_list_UK # Female parity transitions
+T_mat_male <- Parity_transfers_by_age_list_UK # Male parity transitions (same as female)
+U_mat_fem <- Female_parity_mortality_list_UK # Female survival
+U_mat_male <- Male_parity_mortality_list_UK # Male survival
+H_mat <- Redistribution_by_parity_list_UK # Birth redistribution matrices
+```
+
+These lists contain period-specific demographic rates:
+
+- `U_mat_fem`/`U_mat_male`: Lists of matrices containing survival probabilities by age (rows) and parity (columns) from 1965-2022
+- `F_mat_fem`/`F_mat_male`: Lists of matrices containing fertility rates by age and parity
+- `T_mat_fem`/`T_mat_male`: Lists of transition matrices showing probabilities of moving between parity states
+- `H_mat`: List of matrices that redistribute newborns to age-class 1 and parity 0
+
+## Running the Parity Model {#parity-model-running}
+
+Now let's implement the two-sex time-varying multi-state model with parity as the stage variable:
+
+> Note: This model run takes approximately 30 minutes to complete, so we let to the reader its run.
+
+```{r parity_model, message=FALSE, warning=FALSE, eval=FALSE}
+# Define time period and parameters
+no_years <- 40 # Run the model for 40 years (1965-2005)
+
+# Run the model
+kin_out_1965_2005 <-
+ kin_multi_stage_time_variant_2sex(
+ U_list_females = U_mat_fem[1:(1+no_years)], # Female survival matrices
+ U_list_males = U_mat_male[1:(1+no_years)], # Male survival matrices
+ F_list_females = F_mat_fem[1:(1+no_years)], # Female fertility matrices
+ F_list_males = F_mat_male[1:(1+no_years)], # Male fertility matrices
+ T_list_females = T_mat_fem[1:(1+no_years)], # Female transition matrices
+ T_list_males = T_mat_fem[1:(1+no_years)], # Male transition matrices
+ H_list = H_mat[1:(1+no_years)], # Birth redistribution matrices
+ birth_female = 1 - 0.51, # UK sex ratio (49% female)
+ parity = TRUE, # Stages represent parity
+ output_kin = c("d", "oa", "ys", "os"), # Selected kin types
+ summary_kin = TRUE, # Produce summary statistics
+ sex_Focal = "Female", # Focal is female
+ initial_stage_Focal = 1, # Focal starts at parity 0
+ # model_years <- seq(1965, 2005, 5), # the sequence of years we model
+ output_years = c(1965, 1975, 1985, 1995, 2005) # Selected output years
+ )
+```
+
+Now we need to recode the stage variables to show meaningful parity labels:
+
+```{r parity_output_recode, message=FALSE, warning=FALSE, eval=FALSE}
+# After running the model, recode the parity stage values
+kin_out_1965_2005$kin_summary <-
+ kin_out_1965_2005$kin_summary %>%
+ mutate(stage_kin = factor(as.numeric(stage_kin) - 1,
+ levels = c(0, 1, 2, 3, 4, 5),
+ labels = c("0", "1", "2", "3", "4", "5+")))
+
+# Do the same for the kin_full dataframe if you're using it
+kin_out_1965_2005$kin_full <-
+ kin_out_1965_2005$kin_full %>%
+ mutate(stage_kin = factor(as.numeric(stage_kin) - 1,
+ levels = c(0, 1, 2, 3, 4, 5),
+ labels = c("0", "1", "2", "3", "4", "5+")))
+```
+
+## Analyzing Kin Counts by Parity {#parity-kin-counts}
+
+Let's examine the structure of the output:
+
+```{r parity_output_show, message=FALSE, warning=FALSE, eval=FALSE}
+head(kin_out_1965_2005$kin_summary)
+```
+
+The output includes:
+
+- `age_focal`: Age of the focal individual
+- `kin_stage`: Stage (parity) of the relatives
+- `sex_kin`: Sex of the relatives
+- `year`: Calendar year of observation
+- `group`: Type of relative (d = children, oa = older aunts/uncles, etc.)
+- `count`: Expected number of living relatives
+- `cohort`: Birth cohort of the focal individual
+
+### Period Analysis of Kin by Parity {#parity-period-analysis}
+
+Let's visualize the distribution of older aunts and uncles by parity for different ages of Focal across different calendar years.
+
+We first restrict Focal's kinship network to aunts and uncles older than Focal's mother by setting `group` == "oa". We visualize the marginal parity distributions of kin: `stage_kin`, for each age of Focal `age_focal`, using different color schemes. Implicit in the below plot is that we really plot Focal's born into different `cohort` -- i.e., in the 2005 panel we show a 50 year old Focal was born in 1955, while a 40 year old Focal was born in 1965.
+
+```{r parity_aunts_uncles, message=FALSE, warning=FALSE, fig.height=6, fig.width=8, eval=FALSE}
+kin_out_1965_2005$kin_summary %>%
+ filter(group == "oa") %>%
+ ggplot(aes(x = age_focal, y = count, color = stage_kin, fill = stage_kin)) +
+ geom_bar(position = "stack", stat = "identity") +
+ facet_grid(sex_kin ~ year) +
+ scale_x_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90,100)) +
+ theme_bw() +
+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
+ labs(
+ title = "Parity distribution of older aunts and uncles by Focal's age",
+ subtitle = "United Kingdom, 1965-2005",
+ x = "Age of focal individual",
+ y = "Number of older aunts and uncles",
+ fill = "Parity",
+ color = "Parity"
+ )
+```
+
+We could also consider any other kin in Focal's network, for instance, offspring using `group` == "d":
+
+```{r parity_offspring, message=FALSE, warning=FALSE, fig.height=6, fig.width=8, eval=FALSE}
+kin_out_1965_2005$kin_summary %>%
+ filter(group == "d") %>%
+ ggplot(aes(x = age_focal, y = count, color = stage_kin, fill = stage_kin)) +
+ geom_bar(position = "stack", stat = "identity") +
+ facet_grid(sex_kin ~ year) +
+ scale_x_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90,100)) +
+ theme_bw() +
+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
+ labs(
+ title = "Parity distribution of children by Focal's age",
+ subtitle = "United Kingdom, 1965-2005",
+ x = "Age of focal individual",
+ y = "Number of children",
+ fill = "Parity",
+ color = "Parity"
+ )
+```
+
+### Cohort Analysis of Kin by Parity {#parity-cohort-analysis}
+
+Since we only ran the model for 40 years (between 1965-2005), there is very little scope to view kinship as cohort-specific.
+
+We can however compare cohorts for 40-year segments of Focal's life. Below, following from the above example, we once again consider offspring and only show Focals born of `cohort` 1910, 1925, or 1965:
+
+```{r parity_cohort, message=FALSE, warning=FALSE, fig.height=6, fig.width=8, eval=FALSE}
+kin_out_1965_2005$kin_summary %>%
+ filter(group == "d", cohort %in% c(1910, 1925, 1965)) %>%
+ ggplot(aes(x = age_focal, y = count, color = stage_kin, fill = stage_kin)) +
+ geom_bar(position = "stack", stat = "identity") +
+ facet_grid(sex_kin ~ cohort) +
+ theme_bw() +
+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
+ labs(
+ title = "Parity distribution of offspring by birth cohort",
+ subtitle = "United Kingdom, ages observed between 1965-2005",
+ x = "Age of focal individual",
+ y = "Number of offspring",
+ fill = "Parity",
+ color = "Parity"
+ )
+```
+
+**Interpretation**:
+
+- The 1910 cohort (observed at ages 55-95): Most offspring have already completed their childbearing, showing a mix of parity states
+- The 1925 cohort (observed at ages 40-80): Offspring are observed during and after their reproductive years
+- The 1965 cohort (observed at ages 0-40): Initially, all offspring are in parity 0, gradually transitioning to higher parities as they age
+
+## Age Distribution of Kin by Parity {#parity-age-distribution}
+
+For more detailed analysis, we can examine the age and parity distribution of specific relatives. Let's look at the younger siblings of a 50-year-old Focal across different years:
+
+```{r parity_siblings_young, message=FALSE, warning=FALSE, fig.height=6, fig.width=8, eval=FALSE}
+kin_out_1965_2005$kin_full %>%
+ filter(group == "ys",
+ age_focal == 50) %>%
+ ggplot(aes(x = age_kin, y = count, color = stage_kin, fill = stage_kin)) +
+ geom_bar(position = "stack", stat = "identity") +
+ facet_grid(sex_kin ~ year) +
+ scale_x_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90,100)) +
+ theme_bw() +
+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
+ labs(
+ title = "Age and parity distribution of younger siblings",
+ subtitle = "For a 50-year-old focal individual, United Kingdom, 1965-2005",
+ x = "Age of sibling",
+ y = "Number of younger siblings",
+ fill = "Parity",
+ color = "Parity"
+ )
+```
+
+Notice the discontinuity along the x-axis at age 50. This reflects the fact that younger siblings cannot be older than Focal (by definition). Similarly, when we examine older siblings, we'll see they cannot be younger than Focal.
+
+With a simple manipulation of the output data frame, we can also plot the age and parity distribution of all siblings combined:
+
+```{r parity_siblings_all, message=FALSE, warning=FALSE, fig.height=6, fig.width=8, eval=FALSE}
+kin_out_1965_2005$kin_full %>%
+ filter((group == "ys" | group == "os"),
+ age_focal == 50) %>%
+ pivot_wider(names_from = group, values_from = count) %>%
+ mutate(count = `ys` + `os`) %>%
+ ggplot(aes(x = age_kin, y = count, color = stage_kin, fill = stage_kin)) +
+ geom_bar(position = "stack", stat = "identity") +
+ facet_grid(sex_kin ~ year) +
+ scale_x_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90,100)) +
+ theme_bw() +
+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
+ labs(
+ title = "Age and parity distribution of all siblings",
+ subtitle = "For a 50-year-old focal individual, United Kingdom, 1965-2005",
+ x = "Age of sibling",
+ y = "Number of siblings",
+ fill = "Parity",
+ color = "Parity"
+ )
+```
+
+# Example 2: Education as the Stage Variable {#education-as-stage}
+
+## Data Preparation {#education-data-preparation}
+
+In our second example, we'll use educational attainment as our stage variable. The data is for Singapore ranging from 2020 to 2090, sourced from the Wittgenstein Center. The data is aggregated into 5-year age groups and 5-year time intervals.
+
+Some simplifying assumptions we make due to data availability:
+
+1. Fertility rates vary with time and education but are identical for both sexes (androgynous approximation)
+2. Age-specific education transition probabilities vary over time but not by sex
+3. Educational transitions for young children follow Singapore's Compulsory Education Act
+4. Demographic rates before 2020 are assumed stable (time-invariant)
+
+Let's load the pre-processed Singapore data:
+
+This data includes:
+
+- `U_mat_fem_edu`/`U_mat_male_edu`: Lists of matrices containing survival probabilities by age (rows) and education (columns) from 2020-2090
+- `F_mat_fem_edu`/`F_mat_male_edu`: Lists of matrices containing fertility rates by age and education
+- `T_mat_fem_edu`/`T_mat_male_edu`: Lists of transition matrices showing probabilities of moving between education states
+- `H_mat_edu`: List of matrices that redistribute newborns to age-class 1 and "no education" category
+
+Before running the model, let's examine some trends in the data:
+
+```{r edu_trends, message=FALSE, warning=FALSE, eval=TRUE}
+# Calculate and plot Total Fertility Rate by education level over time
+tfr_data <- lapply(seq_along(F_mat_fem_edu), function(i) {
+ col_sums <- colSums(F_mat_fem_edu[[i]])
+ data.frame(
+ year = 2020 + (i - 1) * 5,
+ education = factor(colnames(F_mat_fem_edu[[i]]),
+ levels = c("e1", "e2", "e3", "e4", "e5", "e6"),
+ labels = c("no education", "incomplete primary",
+ "primary", "lower secondary",
+ "upper secondary", "post-secondary")),
+ tfr = col_sums
+ )
+})
+
+tfr_df <- do.call(rbind, tfr_data)
+
+# Plot TFR trends
+ggplot(tfr_df, aes(x = year, y = tfr, color = education, group = education)) +
+ geom_line(size = 1) +
+ geom_point() +
+ theme_minimal() +
+ labs(
+ title = "Total Fertility Rate by Education Over Time",
+ x = "Year",
+ y = "TFR",
+ color = "Education"
+ )
+```
+
+## Running the Education Model {#education-model-running}
+
+Now let's implement the two-sex time-varying multi-state model with education as the stage variable:
+
+```{r education_model, message=FALSE, warning=FALSE, eval=TRUE}
+# Define time period and parameters
+time_range <- seq(2020, 2090, 5)
+no_years <- length(time_range) - 1
+output_year <- seq(1, no_years + 1, 1)
+
+# Run the model
+kin_out_2020_2090 <-
+ kin_multi_stage_time_variant_2sex(
+ U_list_females = U_mat_fem_edu[1:(1+no_years)], # Female survival matrices
+ U_list_males = U_mat_male_edu[1:(1+no_years)], # Male survival matrices
+ F_list_females = F_mat_fem_edu[1:(1+no_years)], # Female fertility matrices
+ F_list_males = F_mat_male_edu[1:(1+no_years)], # Male fertility matrices
+ T_list_females = T_mat_fem_edu[1:(1+no_years)], # Female transition matrices
+ T_list_males = T_mat_fem_edu[1:(1+no_years)], # Male transition matrices
+ H_list = H_mat_edu[1:(1+no_years)], # Birth redistribution matrices
+ birth_female = 1/(1.06+1), # Singapore sex ratio (48.5% female)
+ parity = FALSE, # Stages represent education
+ summary_kin = TRUE, # Produce summary statistics
+ sex_Focal = "Female", # Focal is female
+ initial_stage_Focal = 1, # Focal starts with no education
+ output_years = output_year # All years
+ )
+```
+
+> Note: This model run takes approximately 3 minutes to complete.
+
+Now we need to recode the stage variables to show meaningful educational labels and convert years/ages to real values (since we used 5-year intervals):
+
+```{r education_recode, message=FALSE, warning=FALSE, eval=TRUE}
+# Recode year and age variables to show correct values
+kin_out_2020_2090$kin_summary <-
+ kin_out_2020_2090$kin_summary %>%
+ mutate(year = (year-1)*5+min(time_range),
+ age_focal = age_focal*5,
+ cohort = year - age_focal,
+ stage_kin = factor(stage_kin, levels = c(1, 2, 3, 4, 5, 6),
+ labels = c(
+ "no education",
+ "incomplete primary",
+ "primary",
+ "lower secondary",
+ "upper secondary",
+ "post-secondary"
+ )))
+
+kin_out_2020_2090$kin_full <-
+ kin_out_2020_2090$kin_full %>%
+ mutate(year = (year-1)*5+min(time_range),
+ age_focal = age_focal*5,
+ age_kin = age_kin*5,
+ cohort = year - age_focal,
+ stage_kin = factor(stage_kin, levels = c(1, 2, 3, 4, 5, 6),
+ labels = c(
+ "no education",
+ "incomplete primary",
+ "primary",
+ "lower secondary",
+ "upper secondary",
+ "post-secondary"
+ )))
+```
+
+## Analyzing Kin by Educational Attainment {#education-kin-analysis}
+
+### Cohort Analysis of Kin by Education {#education-cohort-analysis}
+
+First, let's visualize the total number of living kin by educational attainment for a woman born in 2020 in Singapore:
+
+```{r education_total_kin, message=FALSE, warning=FALSE, fig.height=6, fig.width=8, eval=TRUE}
+kin_out_2020_2090$kin_summary %>%
+ # Exclude Focal from the analysis
+ filter(group != "Focal") %>%
+ filter(cohort == 2020) %>%
+ rename(kin = group) %>%
+ # rename_kin(sex = "2sex") %>%
+ summarise(count = sum(count), .by = c(stage_kin, age_focal)) %>%
+ ggplot(aes(x = age_focal, y = count, fill = stage_kin)) +
+ geom_area(colour = "black") +
+ labs(
+ title = "Total living kin by educational attainment over the life course",
+ subtitle = "For a woman born in 2020, Singapore",
+ y = "Expected number of living kin",
+ x = "Age of focal individual",
+ fill = "Educational attainment"
+ ) +
+ theme_bw() +
+ theme(legend.position = "bottom")
+```
+
+Now let's look at specific types of relatives:
+
+```{r education_specific_kin, message=FALSE, warning=FALSE, fig.height=6, fig.width=8, eval=TRUE}
+kin_out_2020_2090$kin_summary %>%
+ filter(group %in% c("d", "gd", "m", "gm")) %>%
+ filter(cohort == 2020) %>%
+ rename(kin = group) %>%
+ # rename_kin(sex = "2sex") %>%
+ summarise(count = sum(count), .by = c(kin, stage_kin, age_focal)) %>%
+ ggplot(aes(x = age_focal, y = count, fill = stage_kin)) +
+ geom_area(colour = "black") +
+ labs(
+ title = "Living kin by educational attainment over the life course",
+ subtitle = "For a woman born in 2020, Singapore",
+ y = "Expected number of living kin",
+ x = "Age of focal individual",
+ fill = "Educational attainment"
+ ) +
+ facet_wrap(. ~ kin) +
+ theme_bw() +
+ theme(legend.position = "bottom")
+```
+
+**Interpretation** This visualization captures how educational expansion transforms family networks, showing the increasing educational diversity across generations in Singapore:
+
+- The total number of living relatives peaks around age 40-50
+- Relatives with upper secondary education (blue) constitute the largest proportion of the kinship network
+- The educational composition of relatives changes dynamically across the life course
+- At younger ages, relatives have lower educational attainment. As Focal ages, the proportion of higher-educated relatives (green, yellow, and red categories) increases
+
+Let's examine the age and educational distribution of key relatives when the focal individual is 60 years old:
+
+```{r education_age_distribution, message=FALSE, warning=FALSE, fig.height=6, fig.width=10, eval=TRUE}
+kin_out_2020_2090$kin_full %>%
+ filter(
+ group %in% c("d", "gd", "m", "gm"),
+ age_focal == 60,
+ cohort == 2020
+ ) %>%
+ rename(kin = group) %>%
+ # rename_kin("2sex") %>%
+ ggplot(aes(x = age_kin, y = count, color = stage_kin, fill = stage_kin)) +
+ geom_bar(position = "stack", stat = "identity") +
+ scale_x_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90,100)) +
+ labs(
+ title = "Age and educational distribution of key relatives",
+ subtitle = "For a 60-year-old woman born in 2020, Singapore",
+ x = "Age of relative",
+ y = "Number of relatives",
+ fill = "Educational attainment",
+ color = "Educational attainment"
+ ) +
+ facet_wrap(. ~ kin) +
+ theme_bw() +
+ theme(
+ axis.text.x = element_text(angle = 90, vjust = 0.5),
+ legend.position = "bottom"
+ )
+```
+
+**Interpretation**: This visualization reveals the evolving educational composition of different types of relatives across the life course for a woman born in 2020 in Singapore:
+
+- **Children** (d): Educational attainment increases with Focal's age, showing a shift towards higher education levels
+- **Grandchildren** (gd): Emerge later in life with a more diverse educational profile
+- **Grandparents** (gm): Predominantly have upper secondary (blue) and lower secondary (teal) education
+- **Parents** (m): Similar to grandparents, with a concentration of upper secondary education
+
+### Period Analysis of Kin by Education {#education-period-analysis}
+
+Now let's examine how the educational composition of specific relatives changes over time. First, let's look at the educational attainment of descendants (children and grandchildren) of 60-year-old women across different calendar years:
+
+```{r education_descendants_time, message=FALSE, warning=FALSE, fig.height=6, fig.width=8, eval=TRUE}
+kin_out_2020_2090$kin_summary %>%
+ filter(
+ group %in% c("d", "gd"),
+ age_focal == 60
+ ) %>%
+ rename(kin = group) %>%
+ # rename_kin(sex = "2sex") %>%
+ summarise(count = sum(count), .by = c(stage_kin, kin, year)) %>%
+ ggplot(aes(x = year, y = count, fill = stage_kin)) +
+ geom_area(colour = "black") +
+ labs(
+ title = "Educational attainment of descendants over time",
+ subtitle = "For women aged 60, Singapore, 2020-2090",
+ y = "Expected number of descendants",
+ x = "Year",
+ fill = "Educational attainment"
+ ) +
+ facet_grid(. ~ kin) +
+ theme_bw() +
+ theme(legend.position = "bottom")
+```
+
+**Interpretation**:
+
+- **Children** (d): Concentrated between ages 30-50, with upper secondary education (blue) being most prevalent
+- **Grandchildren** (gd): Mostly young (under 20), with emerging educational diversity
+- **Grandparents** (gm): No longer living at this point
+- **Parents** (m): Clustered around ages 80-90, with upper secondary and lower secondary education dominating
+
+# Limitations and Assumptions {#limitations}
+
+When implementing these models, we've made several simplifying assumptions due to data limitations:
+
+For the UK parity model:
+
+1. Fertility rates vary with time and parity but are the same across sexes
+2. Mortality rates vary with time and sex but are the same across parity classes
+3. Parity progression probabilities vary with time but are the same across sexes
+
+For the Singapore education model:
+
+1. Fertility rates vary over time and by education but are identical for both sexes
+2. Age-specific education transition probabilities vary over time but not by sex
+3. Educational transitions for young children follow Singapore's Compulsory Education Act
+4. Demographic rates before 2020 are assumed stable (time-invariant)
+
+These assumptions should be kept in mind when interpreting the results.
+
+# Conclusion
+
+In this vignette, we've implemented two-sex time-varying multi-state kinship models—the most comprehensive demographic kinship framework currently available. By integrating age, sex, time, and stage dimensions, these models provide unprecedented insights into family structures and their evolution.
+
+Our two examples demonstrated the analytical power of this integrated approach:
+
+- The parity example revealed how reproductive patterns shape family structures differently for males and females across historical periods
+- The education example showed how educational expansion transforms kinship networks, creating increasingly educated family systems over time
+
+These comprehensive models have numerous applications across disciplines:
+
+- Understanding intergenerational transmission of socioeconomic status
+- Analyzing care needs and support networks in diverse populations
+- Projecting how family structures might evolve under different demographic scenarios
+- Exploring how education, health, marriage, and other characteristics intersect with kinship
+
+# References
diff --git a/vignettes/Reference.Rmd b/vignettes/Reference.Rmd
deleted file mode 100644
index 388a072..0000000
--- a/vignettes/Reference.Rmd
+++ /dev/null
@@ -1,285 +0,0 @@
----
-title: "Expected kin counts by type of relative: A matrix implementation"
-output:
- html_document:
- toc: true
- toc_depth: 1
-vignette: >
- %\VignetteIndexEntry{Use}
- %\VignetteEngine{knitr::rmarkdown}
- %\VignetteEncoding{UTF-8}
----
-
-```{r, include=FALSE}
-devtools::load_all()
-```
-
-In this vignette, we'll demonstrate how `DemoKin` can be used to compute kinship networks for an average member of a given (female) population. Let us call her Focal: an average Swedish woman who has always lived in Sweden and whose family has never left the country.
-Here, we'll show how `DemoKin` can be used to compute the number and age distribution of Focal's relatives under a range of assumptions, including living and deceased kin.
-
-## 1. Kin counts with time-invariant rates
-
-First, we compute kin counts in a **time-invariant** framework. We assume that Focal and all of her relatives experience the 2015 mortality and fertility rates throughout their entire lives (Caswell, 2019). The `DemoKin` package includes data from Sweden as an example: age-by-year matrices of survival probabilities (*swe_px*), survival ratios (*swe_Sx*), fertility rates (*swe_asfr*), and population numbers (*swe_pop*). You can see the data contained in `DemoKin` with `data(package="DemoKin")`. This data comes from the [Human Mortality Database](https://www.mortality.org/) and [Human Fertility Database](https://www.humanfertility.org/) (see `?DemoKin::get_HMDHFD`).
-
-In order to implement the time-invariant models, the function `DemoKin::kin` expects a vector of sruvival ratios and another vector of fertility rates. In this example, we get the data for the year 2015, and run the matrix models:
-
-```{r, message=FALSE, warning=FALSE}
-library(DemoKin)
-library(tidyverse)
-library(knitr)
-# First, get vectors for a given year
-swe_surv_2015 <- swe_px[,"2015"]
-swe_asfr_2015 <- swe_asfr[,"2015"]
-# Run kinship models
-swe_2015 <- kin(U = swe_surv_2015, f = swe_asfr_2015, time_invariant = TRUE)
-```
-
-### 1.1. Value
-
-`DemoKin::kin()` returns a list containing two data frames: `kin_full` and `kin_summary`.
-
-`kin_full` contains expected kin counts by year (or cohort), age of Focal and age of kin. Note that the columns `year` and `cohort` are empty if the argument is `time_invariant = TRUE` in `kin` (as in this example).
-
-```{r}
-head(swe_2015$kin_full)
-```
-
-`kin_summary` is a ‘summary’ data frame derived from `kin_full`.
-
-```{r}
-head(swe_2015$kin_summary)
-```
-
-To produce it, we sum over all ages of kin to produce a data frame of expected kin counts by year or cohort and age of Focal (but not by age of kin).
-Consider this simplified example for living kin counts:
-
-```{r}
-kin_summary_example <-
- swe_2015$kin_full %>%
- select(year, cohort, kin, age_focal, age_kin, living, dead) %>%
- group_by(year, cohort, kin, age_focal) %>%
- summarise(count_living = sum(living))
-
-head(kin_summary_example)
-```
-
-### 1.2. Visualizing the distribution of kin
-
-Let us now visualize the distribution of relatives over Focal's lifecourse using the summary data.frame `kin_summary`:
-
-```{r, fig.height=6, fig.width=8}
-swe_2015[["kin_summary"]] %>%
- ggplot() +
- geom_line(aes(age_focal, count_living)) +
- theme_bw() +
- labs(y = "Expected number of living relatives") +
- facet_wrap(~kin)
-```
-
-Here, each relative type is identified by a unique code. Note that `DemoKin` uses different codes than Caswell (2019); the equivalence between the two set of codes is given in the following table:
-
-```{r, fig.height=6, fig.width=8, echo=FALSE}
-library(knitr)
-
-DemoKin::demokin_codes() %>%
- kable
-```
-
-We can also visualize the age distribution of relatives when Focal is 35 years old (now, with full names to identify each relative type using the function `DemoKin::rename_kin()`):
-
-```{r, fig.height=6, fig.width=8}
-swe_2015[["kin_full"]] %>%
- DemoKin::rename_kin() %>%
- filter(age_focal == 35) %>%
- ggplot() +
- geom_line(aes(age_kin, living)) +
- geom_vline(xintercept = 35, color=2) +
- labs(y = "Expected number of living relatives") +
- theme_bw() +
- facet_wrap(~kin)
-```
-
-The one-sex model implemented in `DemoKin` assumes that the given fertility input applies to both sexes.
-
-Note that, if using survival rates ($S_x$) instead of probabilities ($p_x$), fertility vectors should account for female person-year exposure, using: $(\frac{f_x+f_{x+1}S_x}{2})\frac{L_0}{l_0}$ instead of only $fx$ (see Preston et.al, 2002).
-
-The `kin` function also includes a summary output with the count of living kin, mean and standard deviation of kin age, by type of kin, for each Focal's age:
-
-```{r, fig.height=6, fig.width=8}
-swe_2015[["kin_summary"]] %>%
- DemoKin::rename_kin() %>%
- filter(age_focal == 35) %>%
- select(kin, count_living, mean_age, sd_age) %>%
- mutate_if(is.numeric, round, 2) %>%
- kable()
-```
-
-Finally, we can visualize the estimated kin counts by type of kin using a network diagram. Following with the age 35:
-
-```{r, fig.height=6, fig.width=8, dpi=900, message=FALSE, warning=FALSE}
- swe_2015[["kin_summary"]] %>%
- filter(age_focal == 35) %>%
- select(kin, count = count_living) %>%
- plot_diagram(rounding = 2)
-```
-
-
-## 2. Kin counts with time-variant rates
-
-The demography of Sweden is, in reality, changing every year. This means that Focal and her relatives will have experienced changing mortality and fertility rates over time.
-We account for this, by using the time-variant models introduced by Caswell and Song (2021).
-Let's take a look at the resulting kin counts for a Focal born in 1960, limiting the output to the relative types given in the argument `output_kin`:
-
-```{r, fig.height=6, fig.width=8}
-swe_time_varying <-
- kin(
- U = swe_px,
- f = swe_asfr,
- N = swe_pop,
- time_invariant =FALSE,
- output_cohort = 1960,
- output_kin = c("d","gd","ggd","m","gm","ggm")
- )
-
-swe_time_varying$kin_summary %>%
- DemoKin::rename_kin() %>%
- ggplot(aes(age_focal,count_living,color=factor(cohort))) +
- scale_y_continuous(name = "",labels = seq(0,3,.2),breaks = seq(0,3,.2))+
- geom_line(color = 1)+
- geom_vline(xintercept = 35, color=2)+
- labs(y = "Expected number of living relatives") +
- facet_wrap(~kin,scales = "free")+
- theme_bw()
-
-```
-
-
-
-## 3. Kin deaths
-
-Kin loss can have severe consequences for bereaved relatives. It can also affect the provision of care support and intergenerational transfers over the life course.
-The function `kin` also includes information on the number of relatives lost by Focal during her life, stored in the column `count_cum_death`:
-
-```{r, fig.height=6, fig.width=8, message=FALSE, warning=FALSE}
-swe_time_varying$kin_summary %>%
- DemoKin::rename_kin() %>%
- ggplot() +
- geom_line(aes(age_focal, count_cum_dead)) +
- labs(y = "Expected number of deceased relatives") +
- theme_bw() +
- facet_wrap(~kin,scales="free")
-```
-
-Given these population-level measures, we can compute Focal's the mean age at the time of her relative's death. For a Focal aged 50 yo:
-
-```{r}
-swe_time_varying$kin_summary %>%
- rename_kin() %>%
- filter(age_focal == 50) %>%
- select(kin,count_cum_dead,mean_age_lost) %>%
- mutate_if(is.numeric, round, 2) %>%
- kable()
-```
-
-## 4. Prevalences
-
-Given the distribution of kin by age, we can compute the expected portion of living kin in some stage given a set of prevalences by age (e.g., a disease, employment, etc.). This is known as the Sullivan Method in the life-table literature. A matrix formulation for same results can be found in Caswell (2019), which can also be extended to a time-variant framework.
-
-```{r, message=FALSE, warning=FALSE, fig.height=6, fig.width=10}
-# let´s create some prevalence by age
-swe_2015_prevalence <-
- tibble(
- age_kin = unique(swe_2015$kin_full$age_kin),
- prev = .005 * exp(.05 * age_kin)
- )
-
-# plot(swe_2015_prevalence)
-
-# join to kin count estimates and plot
-swe_2015$kin_full %>%
- left_join(swe_2015_prevalence) %>%
- group_by(kin, age_focal) %>%
- rename_kin() %>%
- summarise(
- prevalent = sum(living * prev),
- no_prevalent = sum(living * (1-prev))
- ) %>%
- pivot_longer(cols = prevalent:no_prevalent, names_to = "prevalence_state", values_to = "count") %>%
- ggplot(aes(x=age_focal, y = count)) +
- geom_area(aes(fill=prevalence_state)) +
- facet_wrap(~kin) +
- theme_bw()
-
-```
-
-## 5. Multi-state models
-
-`DemoKin` allows the computation of kin structures in a multi-state framework, classifying individuals jointly by age and some other feature (e.g., stages of a disease). For this, we need mortality and fertility data for each possible stage and probabilities of changing state by age.
-
-Let's consider the example of Slovakia given by Caswell (2021), where stages are parity states.
-`DemoKin` includes the data to replicate this analysis for the year 1980:
-
-- The data.frame `svk_fxs` is the fertility rate by age (rows) for each parity stage (columns). The first stage represents $parity=0$; the second stage, $parity=1$; and so on, until finally the sixth stage represents $parity\geq5$.
-- The data.frame `svk_Hxs` has a similar structure but with $1$'s in the ages corresponding to newborns (the first age in our example).
-- The data.frame `svk_pxs` has the same structure and represents survival probabilities.
-- The list `svk_Uxs` has the same number of elements and ages (in this case 110, where $omega$ is 109). For each age, it contains a column-stochastic transition matrix with dimension for the state space. The entries are transition probabilities conditional on survival.
-
-Following Caswell (2020), we can obtain the joint age-parity kin structure:
-
-```{r}
-# use birth_female=1 because fertility is for female only
-demokin_svk1980_caswell2020 <-
- kin_multi_stage(
- U = svk_Uxs,
- f = svk_fxs,
- D = svk_pxs,
- H = svk_Hxs,
- birth_female=1
- )
-```
-
-As an example, consider the age-parity distribution of aunts, when Focal is 20 and 60 yo (this is equivalent to Figure 4 in Caswell [2021]).
-
-```{r, message=FALSE, warning=FALSE, fig.height=6, fig.width=10}
-demokin_svk1980_caswell2020 %>%
- filter(kin %in% c("oa","ya"), age_focal %in% c(20,60)) %>%
- mutate(parity = as.integer(stage_kin)-1,
- parity = case_when(parity == 5 ~ "5+", T ~ as.character(parity)),
- parity = fct_rev(parity)) %>%
- group_by(age_focal, age_kin, parity) %>%
- summarise(count= sum(living)) %>%
- ggplot() +
- geom_bar(aes(x=age_kin, y = count, fill=parity), stat = "identity") +
- geom_vline(aes(xintercept = age_focal), col=2) +
- labs(y = "Number of aunts") +
- theme_bw() +
- facet_wrap(~age_focal, nrow = 2)
-```
-
-We can also see the portion of living daughters and mothers at different parity stages over Focal's lie-course (this is equivalent to Figure 9 and 10 in Caswell [2021]).
-
-```{r, message=FALSE, warning=FALSE, fig.height=6, fig.width=10}
-demokin_svk1980_caswell2020 %>%
- filter(kin %in% c("d","m")) %>%
- mutate(parity = as.integer(stage_kin)-1,
- parity = case_when(parity == 5 ~ "5+", T ~ as.character(parity)),
- parity = fct_rev(parity)) %>%
- group_by(age_focal, kin, parity) %>%
- summarise(count= sum(living)) %>%
- DemoKin::rename_kin() %>%
- ggplot() +
- geom_bar(aes(x=age_focal, y = count, fill=parity), stat = "identity") +
- labs(y = "Kin count") +
- theme_bw() +
- facet_wrap(~kin, nrow = 2)
-```
-
-## References
-
-Caswell, H. (2019). The formal demography of kinhip: A matrix formulation. Demographic Research 41:679–712. doi:10.4054/DemRes.2019.41.24.
-
-Caswell, H. (2020). The formal demography of kinship II: Multistate models, parity, and sibship. Demographic Research, 42, 1097–1146.
-
-Caswell, H., & Song, X. (2021). The formal demography of kinhip III: kinhip dynamics with time-varying demographic rates. Demographic Research, 45, 517–546.
-
-Preston, S., Heuveline, P., & Guillot, M. (2000). Demography: Measuring and Modeling Population Processes. Wiley.
diff --git a/vignettes/references.bib b/vignettes/references.bib
new file mode 100644
index 0000000..25c5b53
--- /dev/null
+++ b/vignettes/references.bib
@@ -0,0 +1,124 @@
+@article{Butterick2025,
+title = {A mathematical framework for time-variant multi-state kinship modelling},
+journal = {Theoretical Population Biology},
+volume = {163},
+pages = {1-12},
+year = {2025},
+issn = {0040-5809},
+doi = {https://doi.org/10.1016/j.tpb.2025.02.002},
+url = {https://www.sciencedirect.com/science/article/pii/S0040580925000103},
+author = {Joe W.B. Butterick and Peter W.F. Smith and Jakub Bijak and Jason Hilton}
+}
+
+@book{Keyfitz2005,
+ title={Applied mathematical demography},
+ author={Keyfitz, Nathan and Caswell, Hal and others},
+ volume={47},
+ year={2005},
+ publisher={Springer}
+}
+
+@article{Caswell2023,
+ author = {Caswell, Hal and Margolis, Rachel and Verdery, Ashton},
+ title = {{The formal demography of kinship V: Kin loss, bereavement, and causes of death}},
+ journal = {Demographic Research},
+ volume = {49},
+ pages = {1163--1200},
+ year = {2023},
+ month = dec,
+ issn = {1435-9871},
+ publisher = {Demographic Research},
+ url = {https://www.demographic-research.org/articles/volume/49/41}
+}
+
+@article{caswell_formal_2019,
+ title = {The formal demography of kinship: {A} matrix formulation},
+ volume = {41},
+ issn = {1435-9871},
+ shorttitle = {The formal demography of kinship},
+ url = {https://www.demographic-research.org/volumes/vol41/24/},
+ doi = {10.4054/DemRes.2019.41.24},
+ language = {en},
+ urldate = {2019-09-17},
+ journal = {Demographic Research},
+ author = {Caswell, Hal},
+ month = sep,
+ year = {2019},
+ pages = {679--712},
+ file = {Full Text:C\:\\Users\\alburezgutierrez\\Zotero\\storage\\C84MW6VX\\Caswell - 2019 - The formal demography of kinship A matrix formula.pdf:application/pdf},
+}
+
+@article{caswell_formal_2020,
+ title = {The formal demography of kinship {II}: {Multistate} models, parity, and sibship},
+ volume = {42},
+ issn = {1435-9871},
+ shorttitle = {The formal demography of kinship {II}},
+ url = {https://www.demographic-research.org/volumes/vol42/38/},
+ doi = {10.4054/DemRes.2020.42.38},
+ language = {en},
+ urldate = {2021-03-05},
+ journal = {Demographic Research},
+ author = {Caswell, Hal},
+ month = jun,
+ year = {2020},
+ pages = {1097--1146},
+ file = {Full Text:C\:\\Users\\alburezgutierrez\\Zotero\\storage\\LEHIM987\\Caswell - 2020 - The formal demography of kinship II Multistate mo.pdf:application/pdf},
+}
+
+@article{caswell_formal_2021,
+ title = {The formal demography of kinship {III}: {Kinship} dynamics with time-varying demographic rates},
+ volume = {45},
+ issn = {1435-9871},
+ shorttitle = {The formal demography of kinship {III}},
+ url = {https://www.demographic-research.org/volumes/vol45/16/},
+ doi = {10.4054/DemRes.2021.45.16},
+ language = {en},
+ urldate = {2021-10-19},
+ journal = {Demographic Research},
+ author = {Caswell, Hal and Song, Xi},
+ month = aug,
+ year = {2021},
+ pages = {517--546},
+ file = {Full Text:C\:\\Users\\alburezgutierrez\\Zotero\\storage\\W2JPMRH8\\Caswell and Song - 2021 - The formal demography of kinship III Kinship dyna.pdf:application/pdf},
+}
+
+@article{caswell_formal_2022,
+ title = {The formal demography of kinship {IV}: {Two}-sex models and their approximations},
+ volume = {47},
+ issn = {1435-9871},
+ shorttitle = {The formal demography of kinship {IV}},
+ url = {https://www.demographic-research.org/volumes/vol47/13/},
+ doi = {10.4054/DemRes.2022.47.13},
+ language = {en},
+ urldate = {2022-09-27},
+ journal = {Demographic Research},
+ author = {Caswell, Hal},
+ month = sep,
+ year = {2022},
+ pages = {359--396},
+ file = {Full Text:C\:\\Users\\alburezgutierrez\\Zotero\\storage\\CWGLWECI\\Caswell - 2022 - The formal demography of kinship IV Two-sex model.pdf:application/pdf},
+}
+
+
+@article{goodman_family_1974,
+ title = {Family {Formation} and the {Frequency} of {Various} {Kinship} {Relationships}},
+ doi = {10.1016/0040-5809(74)90049-5},
+ language = {en},
+ journal = {Theoretical Population Biology},
+ author = {Goodman, Leo A and Keyfitz, Nathan and Pullum, Thomas W.},
+ year = {1974},
+ pages = {27},
+ file = {Goodman - Family Formation and the Frequency of Various Kins.pdf:C\:\\Users\\alburezgutierrez\\Zotero\\storage\\8ICBKYIE\\Goodman - Family Formation and the Frequency of Various Kins.pdf:application/pdf},
+}
+
+
+@book{preston_demography:_2001,
+ address = {Malden, MA},
+ title = {Demography: measuring and modeling population processes},
+ isbn = {978-1-55786-214-3 978-1-55786-451-2},
+ shorttitle = {Demography},
+ publisher = {Blackwell Publishers},
+ author = {Preston, Samuel H. and Heuveline, Patrick and Guillot, Michel},
+ year = {2001},
+ keywords = {Demography, Population research},
+}