Last updated: 2024-09-22
Checks: 6 1
Knit directory: PODFRIDGE/
This reproducible R Markdown analysis was created with workflowr (version 1.7.1). The Checks tab describes the reproducibility checks that were applied when the results were created. The Past versions tab lists the development history.
The R Markdown file has unstaged changes. To know which version of
the R Markdown file created these results, you’ll want to first commit
it to the Git repo. If you’re still working on the analysis, you can
ignore this warning. When you’re finished, you can run
wflow_publish
to commit the R Markdown file and build the
HTML.
Great job! The global environment was empty. Objects defined in the global environment can affect the analysis in your R Markdown file in unknown ways. For reproduciblity it’s best to always run the code in an empty environment.
The command set.seed(20230302)
was run prior to running
the code in the R Markdown file. Setting a seed ensures that any results
that rely on randomness, e.g. subsampling or permutations, are
reproducible.
Great job! Recording the operating system, R version, and package versions is critical for reproducibility.
Nice! There were no cached chunks for this analysis, so you can be confident that you successfully produced the results during this run.
Great job! Using relative paths to the files within your workflowr project makes it easier to run your code on other machines.
Great! You are using Git for version control. Tracking code development and connecting the code version to the results is critical for reproducibility.
The results in this page were generated with repository version 78c1621. See the Past versions tab to see a history of the changes made to the R Markdown and HTML files.
Note that you need to be careful to ensure that all relevant files for
the analysis have been committed to Git prior to generating the results
(you can use wflow_publish
or
wflow_git_commit
). workflowr only checks the R Markdown
file, but you know if there are other scripts or data files that it
depends on. Below is the status of the Git repository when the results
were generated:
Ignored files:
Ignored: .DS_Store
Ignored: .Rhistory
Ignored: .Rproj.user/
Ignored: data/.DS_Store
Ignored: data/sims/.DS_Store
Ignored: output/.DS_Store
Ignored: output/simulation_20240726-155743/.DS_Store
Ignored: output/simulation_20240726-162034_11228488/.DS_Store
Ignored: output/simulation_20240726-163235_11228791/.DS_Store
Unstaged changes:
Modified: analysis/relative-distribution.Rmd
Note that any generated files, e.g. HTML, png, CSS, etc., are not included in this status report because it is ok for generated content to have uncommitted changes.
These are the previous versions of the repository in which changes were
made to the R Markdown (analysis/relative-distribution.Rmd
)
and HTML (docs/relative-distribution.html
) files. If you’ve
configured a remote Git repository (see ?wflow_git_remote
),
click on the hyperlinks in the table below to view the files as they
were in that past version.
File | Version | Author | Date | Message |
---|---|---|---|---|
Rmd | 78c1621 | Tina Lasisi | 2024-09-21 | Update relative-distribution.Rmd |
Rmd | f4c2830 | Tina Lasisi | 2024-09-21 | Update relative-distribution.Rmd |
Rmd | 2851385 | Tina Lasisi | 2024-09-21 | rename old analysis |
html | 2851385 | Tina Lasisi | 2024-09-21 | rename old analysis |
The relative genetic surveillance of a population is influenced by the number of genetically detectable relatives individuals have. First-degree relatives (parents, siblings, and children) are especially relevant in forensic analyses using short tandem repeat (STR) loci, where close familial searches are commonly employed. To explore potential disparities in genetic detectability between African American and European American populations, we examined U.S. Census data from four census years (1960, 1970, 1980, and 1990) focusing on the number of children born to women over the age of 40.
We used publicly available data from the Integrated Public Use Microdata Series (IPUMS) for the U.S. Census years 1960, 1970, 1980, and 1990. The datasets include information on:
Data citation: Steven Ruggles, Sarah Flood, Matthew Sobek, Daniel Backman, Annie Chen, Grace Cooper, Stephanie Richards, Renae Rogers, and Megan Schouweiler. IPUMS USA: Version 14.0 [dataset]. Minneapolis, MN: IPUMS, 2023. https://doi.org/10.18128/D010.V14.0
Filtering Criteria: We selected women aged 40 and above to ensure that most had completed childbearing.
Due to the terms of agreement for using this data, we cannot share the full dataset but our repo contains the subset that was used to calculate the mean number of offspring and variance.
Race Classification: We categorized individuals into two groups:
Calculating Number of Siblings: For each child of these women, the number of siblings (n_sib) is one less than the number of children born to the mother:
\[ n_{sib} = chborn_{num} - 1 \]
# children_data = read.csv("./data/proportions_table_by_race_year.csv")
mother_data = read.csv("./data/data_filtered_recoded.csv")
df <- mother_data %>%
# Filter for women aged 40 and above
filter(AGE >= 40) %>%
mutate(
# Create new age ranges
AGE_RANGE = case_when(
AGE >= 70 ~ "70+",
AGE >= 60 ~ "60-69",
AGE >= 50 ~ "50-59",
AGE >= 40 ~ "40-49",
TRUE ~ as.character(AGE_RANGE) # This shouldn't occur due to the filter, but included for completeness
),
# Convert CHBORN to ordered factor
CHBORN = factor(case_when(
chborn_num == 0 ~ "No children",
chborn_num == 1 ~ "1 child",
chborn_num == 2 ~ "2 children",
chborn_num == 3 ~ "3 children",
chborn_num == 4 ~ "4 children",
chborn_num == 5 ~ "5 children",
chborn_num == 6 ~ "6 children",
chborn_num == 7 ~ "7 children",
chborn_num == 8 ~ "8 children",
chborn_num == 9 ~ "9 children",
chborn_num == 10 ~ "10 children",
chborn_num == 11 ~ "11 children",
chborn_num >= 12 ~ "12+ children"
), levels = c("No children", "1 child", "2 children", "3 children",
"4 children", "5 children", "6 children", "7 children",
"8 children", "9 children", "10 children", "11 children",
"12+ children"), ordered = TRUE),
# Ensure RACE variable is correctly formatted and filtered
RACE = factor(RACE, levels = c("White", "Black/African American"))
) %>%
# Filter for African American and European American women
filter(RACE %in% c("Black/African American", "White")) %>%
# Select and reorder columns
select(YEAR, SEX, AGE, BIRTHYR, RACE, CHBORN, AGE_RANGE, chborn_num)
# Display the first few rows of the processed data
head(df)
YEAR SEX AGE BIRTHYR RACE CHBORN AGE_RANGE chborn_num
1 1960 Female 65 1894 White No children 60-69 0
2 1960 Female 49 1911 White 2 children 40-49 2
3 1960 Female 54 1905 White No children 50-59 0
4 1960 Female 56 1903 White 1 child 50-59 1
5 1960 Female 54 1905 White 1 child 50-59 1
6 1960 Female 50 1910 White No children 50-59 0
# Summary of the processed data
summary(df)
YEAR SEX AGE BIRTHYR
Min. :1960 Length:1917477 Min. : 41.00 Min. :1859
1st Qu.:1970 Class :character 1st Qu.: 49.00 1st Qu.:1905
Median :1970 Mode :character Median : 58.00 Median :1916
Mean :1976 Mean : 59.24 Mean :1916
3rd Qu.:1980 3rd Qu.: 68.00 3rd Qu.:1926
Max. :1990 Max. :100.00 Max. :1949
RACE CHBORN AGE_RANGE
White :1740755 2 children :452594 Length:1917477
Black/African American: 176722 No children:343319 Class :character
3 children :335119 Mode :character
1 child :292001
4 children :204983
5 children :113593
(Other) :175868
chborn_num
Min. : 0.00
1st Qu.: 1.00
Median : 2.00
Mean : 2.57
3rd Qu.: 4.00
Max. :12.00
# Check the levels of the RACE factor
levels(df$RACE)
[1] "White" "Black/African American"
# Count of observations by RACE
table(df$RACE)
White Black/African American
1740755 176722
# Count of observations by AGE_RANGE
table(df$AGE_RANGE)
40-49 50-59 60-69 70+
529160 517620 436829 433868
First we visualize the general trends in the frequency of the number of children for African American and European American mothers across the Census years by age group.
# Calculate proportions within each group, ensuring proper normalization
df_proportions <- df %>%
group_by(YEAR, RACE, AGE_RANGE, chborn_num) %>%
summarise(count = n(), .groups = "drop") %>%
group_by(YEAR, RACE, AGE_RANGE) %>%
mutate(proportion = count / sum(count)) %>%
ungroup()
# Reshape data for the mirror plot
df_mirror <- df_proportions %>%
mutate(proportion = if_else(RACE == "White", -proportion, proportion))
# Create color palette
my_colors <- colorRampPalette(c("#FFB000", "#F77A2E", "#DE3A8A", "#7253FF", "#5E8BFF"))(13)
# Create the plot
ggplot(df_mirror, aes(x = chborn_num, y = proportion, fill = as.factor(chborn_num))) +
geom_col(aes(alpha = RACE)) +
geom_hline(yintercept = 0, color = "black", size = 0.5) +
facet_grid(AGE_RANGE ~ YEAR, scales = "free_y") +
coord_flip() +
scale_y_continuous(
labels = function(x) abs(x),
limits = function(x) c(-max(abs(x)), max(abs(x)))
) +
scale_x_continuous(breaks = 0:12, labels = c(0:11, "12+")) +
scale_fill_manual(values = my_colors) +
scale_alpha_manual(values = c("White" = 0.7, "Black/African American" = 1)) +
labs(
title = "Distribution of Number of Children by Census Year, Race, and Age Range",
x = "Number of Children",
y = "Proportion",
fill = "Number of Children",
caption = "White population shown on left (negative values), Black/African American on right (positive values)\nProportions normalized within each age range, race, and census year\nFootnote: The category '12+' includes families with 12 or more children."
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, hjust = 0.5),
axis.text.y = element_text(size = 8),
strip.text = element_text(size = 10),
legend.position = "none",
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank()
)
Version | Author | Date |
---|---|---|
2851385 | Tina Lasisi | 2024-09-21 |
# Save the plot (optional)
# ggsave("children_distribution_mirror_plot.png", width = 20, height = 25, units = "in", dpi = 300)
# Print summary to check age ranges and normalization
print(df_proportions %>%
group_by(YEAR, RACE, AGE_RANGE) %>%
summarise(total_proportion = sum(proportion), .groups = "drop") %>%
arrange(YEAR, RACE, AGE_RANGE))
# A tibble: 32 × 4
YEAR RACE AGE_RANGE total_proportion
<int> <fct> <chr> <dbl>
1 1960 White 40-49 1
2 1960 White 50-59 1
3 1960 White 60-69 1
4 1960 White 70+ 1
5 1960 Black/African American 40-49 1
6 1960 Black/African American 50-59 1
7 1960 Black/African American 60-69 1
8 1960 Black/African American 70+ 1
9 1970 White 40-49 1
10 1970 White 50-59 1
# ℹ 22 more rows
With this visualization of the distribution of the data, we can see that there are differences between White and Black Americans.
We will now test for differences in 1) the mean and variance, and 2) zero-inflation.
Question 1) What is the best model for the distribution of the data in each of these subsets of data (by race, by census year, by age range combined)?
For each combination of race, census year, and age range, fit your candidate models:
This should be done for each subset of the data (race × census year × age range).
Understanding the Data:
Candidate Models for Count Data:
Recommended Approach:
1: Exploratory Data Analysis (EDA)
2: Model Selection
Scenario 1: Overdispersion Without Excess Zeros
Scenario 2: Overdispersion With Excess Zeros
Scenario 3: No Overdispersion, No Excess Zeros
3: Fit Models to Each Subset
Once the models are fitted, compare them using goodness-of-fit criteria like AIC or BIC for each subset. The model with the lowest AIC/BIC is the best fit for that subset.
# example code to start you off. edit and comment appropriately
# Load necessary libraries
library(MASS) # For negative binomial
library(pscl) # For zero-inflated models
# Suppose 'df' is your dataset
# Subset data for each race
df_black <- subset(df, RACE == "Black/African American")
df_white <- subset(df, RACE == "White")
# Example for Black women over 40 in 1990 census
# Calculate mean and variance
mean_black <- mean(df_black$chborn_num)
var_black <- var(df_black$chborn_num)
# Check for overdispersion
if (var_black > mean_black) {
# Overdispersion present
}
# Check for zero-inflation
prop_zero <- sum(df_black$chborn_num == 0) / nrow(df_black)
# Compare prop_zero to expected under Poisson or NB
# Fit Negative Binomial Model
nb_model_black <- glm.nb(chborn_num ~ AGE_RANGE + YEAR, data = df_black)
# Fit Zero-Inflated Negative Binomial Model if necessary
zinb_model_black <- zeroinfl(chborn_num ~ AGE_RANGE + YEAR | 1, data = df_black, dist = "negbin")
# Compare models using AIC
AIC(nb_model_black, zinb_model_black)
# Repeat for White women and other subsets
Create a table or data frame where you store the best model for each combination of race, census year, and age range based on AIC/BIC. For example:
Race | Census Year | Age Range | Best Model |
---|---|---|---|
Black/African Am. | 1990 | 40-49 | Negative Binomial |
White | 1990 | 40-49 | Zero-Inflated NB |
White | 1980 | 50-59 | Poisson |
… | … | … | … |
(but obviously do this as a dataframe so we can analyze it)
Once you’ve gathered the best model for each subset, you can analyze which factor (race, census year, or age range) is most influential in determining the best-fitting model.
Options for statistical analysis:
#example
#
## Create a contingency table
table_model_race <- table(best_model_data$Race, best_model_data$Best_Model)
# Perform chi-square test
chisq.test(table_model_race)
Logistic Regression: You could fit a logistic regression model where the response variable is the best-fitting model (binary or multinomial) and the predictor variables are race, census year, and age range. This will allow you to quantify the effect of each variable on the model choice.
Example in R (assuming binary outcome: Poisson vs. NB):
# Fit logistic regression model
model_logistic <- glm(Best_Model ~ Race + Census_Year + Age_Range, family = binomial(), data = best_model_data)
# Summary of results
summary(model_logistic)
Multinomial Logistic Regression (if more than two models): If you have multiple possible best-fitting models (Poisson, NB, ZIP, ZINB), you can use multinomial logistic regression to assess the impact of race, census year, and age range on model selection.
Example in R using the nnet
package:
library(nnet)
# Fit multinomial logistic regression
model_multinom <- multinom(Best_Model ~ Race + Census_Year + Age_Range, data = best_model_data)
# Summary of results
summary(model_multinom)
Finally, visualize the distribution of the best-fitting models across races, census years, and age groups.
Example of a simple bar plot in R:
library(ggplot2)
# Bar plot showing the distribution of best models across races
ggplot(best_model_data, aes(x = Race, fill = Best_Model)) +
geom_bar(position = "dodge") +
labs(title = "Best-Fitting Models by Race", x = "Race", y = "Count", fill = "Best Model")
For Question 2: Cohort Stability Analysis, the goal is to determine if there is a significant change in zero inflation, family size, or model fit for the same cohort across different census years, given race.
Using the existing table of model summaries, calculate the birth-year cohort based on the Census Year and Age Range. For example, if a woman is in the 40-49 age range in the 1990 Census, her birth cohort would be 1941-1950.
Cohort
.Example Table:
Race | Census Year | Age Range | Best Model | Cohort |
---|---|---|---|---|
Black/African Am. | 1990 | 40-49 | Negative Binomial | 1941-1950 |
White | 1990 | 40-49 | Zero-Inflated NB | 1941-1950 |
White | 1980 | 50-59 | Poisson | 1921-1930 |
… | … | … | … | … |
For each combination of Race, Cohort, and Census Year, compute additional summary statistics for family size distributions: - Mean, Variance, Mode of the number of children. - Probability of having 0, 1, 2, …, 12+ children (empirical or from the best-fitting model).
These statistics will help quantify family size changes over time.
Example Summary Table:
Race | Cohort | Census Year | Best Model | Mean | Variance | Mode | Prob(0) | Prob(1) | Prob(2) | … | Prob(12+) |
---|---|---|---|---|---|---|---|---|---|---|---|
Black/African Am. | 1941-1950 | 1990 | Negative Binomial | 2.5 | 1.2 | 2 | 0.20 | 0.30 | 0.25 | … | 0.01 |
White | 1941-1950 | 1990 | Zero-Inflated NB | 2.1 | 1.0 | 2 | 0.35 | 0.28 | 0.20 | … | 0.01 |
White | 1921-1930 | 1980 | Poisson | 3.0 | 1.5 | 3 | 0.15 | 0.25 | 0.30 | … | 0.05 |
… | … | … | … | … | … | … | … | … | … | … | … |
Once the cohort information and summary statistics are available, the goal is to determine if there is a significant change in any of the following across census years for the same cohort:
Use a logistic regression model to assess if the probability of having zero children changes significantly over time for the same cohort.
Example Code:
# Fit logistic regression to check if zero-inflation changes over time
zero_inflation_model <- glm(Zero_Children ~ Census_Year + Race + Cohort,
family = binomial(), data = cohort_data)
# Summary of the model
summary(zero_inflation_model)
Use an ANOVA or linear regression to test if the mean or variance in family size changes over census years for the same cohort.
Example Code:
# Fit linear model to check for changes in family size over time
family_size_model <- lm(Number_of_Children ~ Census_Year + Race + Cohort, data = cohort_data)
# ANOVA to check for significant differences
anova(family_size_model)
If the best-fitting model changes for the same cohort over time, this suggests that the distribution of family sizes has shifted. Use multinomial logistic regression to test if the model fit differs across census years for the same cohort.
Example Code:
library(nnet)
# Fit multinomial logistic regression to test changes in best-fitting model
model_fit_analysis <- multinom(Best_Model ~ Census_Year + Race + Cohort, data = cohort_data)
# Summary of the model
summary(model_fit_analysis)
For each cohort, you will assess whether: - Zero-inflation changes significantly over time (i.e., whether the probability of having no children decreases or increases across census years). - Family size (mean, variance, mode) changes significantly over time. - The best-fitting model changes over time, indicating a shift in family size distributions.
If significant changes are detected for a cohort (e.g., the same cohort switches from a zero-inflated model to a non-zero-inflated model, or family sizes decrease), this indicates a shift in the demographic pattern for that group.
This analysis will allow you to evaluate cohort stability by testing whether demographic patterns (e.g., zero-inflation, family size) are consistent over time for the same cohort or if there are notable shifts. If the patterns change significantly, you will be able to identify when and how the demographic trends for each cohort begin to deviate from their earlier distribution.
For Question 3: Significant Fertility shifts, the goal is to summarize the information in the top 2 questions and create a comprehensive analysis and visualization that illustrates significant fertility shifts in cohorts, compares fertility patterns of 40-49 year-olds to 50-59 year-olds in the 1990 census so we can pick the set of fertility distributions we want to use to visualize the sibling distribution and do the math on the genetic surveillance.
Create a comprehensive analysis and visualization that:
The steps below are suggestions: use critical thinking and your judgement to complete this task and answer the question
chborn_num
)AGE_RANGE
)RACE
)Design visualizations that effectively communicate your findings.
Conduct statistical tests to determine if observed differences are significant.
Write a clear and concise summary addressing the following points.
Having analyzed the distribution of the number of children, we now turn our attention to the distribution of the number of siblings. We will explore the trends in the frequency of the number of siblings for African American and European American mothers across the Census years by age group.
Frequency of siblings is calculated as follows.
\[ \text{freq}_{n_{\text{sib}}} = \text{freq}_{\text{mother}} \cdot \text{chborn}_{\text{num}} \]
For example, suppose 10 mothers (generation 0) have 7 children, then there will be 70 children (generation 1) in total who each have 6 siblings.
We take our original data and calculate the frequency of siblings for each mother based on the number of children they have. We then aggregate this data to get the frequency of siblings for each generation along with details on the birthyears of the relevant children to visualize the distribution of the number of siblings across generations.
Create a mirror plot for the distribution of siblings across census years, races, and birth ranges, similar to the one created for the number of children.
Start with your dataframe that includes the
birth_range
column.
Create a new column for the number of siblings:
df <- df %>%
mutate(n_siblings = chborn_num - 1)
df <- df %>%
mutate(sibling_freq = n_siblings * 1) # Assuming each mother represents 1 in frequency
df_siblings <- df %>%
group_by(YEAR, RACE, birth_range, n_siblings) %>%
summarise(
sibling_count = sum(sibling_freq),
.groups = "drop"
)
df_sibling_proportions <- df_siblings %>%
group_by(YEAR, RACE, birth_range) %>%
mutate(proportion = sibling_count / sum(sibling_count)) %>%
ungroup()
Before creating the plot, verify that the proportions are correctly normalized:
normalization_check <- df_sibling_proportions %>%
group_by(YEAR, RACE, birth_range) %>%
summarise(total_proportion = sum(proportion), .groups = "drop") %>%
arrange(YEAR, RACE, birth_range)
print(normalization_check)
Ensure that the total_proportion
for each group is very
close to 1.0. If not, revisit your calculations in Step 2.
Reshape data for the mirror plot:
df_sibling_mirror <- df_sibling_proportions %>%
mutate(proportion = if_else(RACE == "White", -proportion, proportion))
my_colors <- colorRampPalette(c("#FFB000", "#F77A2E", "#DE3A8A", "#7253FF", "#5E8BFF"))(13)
ggplot(df_sibling_mirror, aes(x = n_siblings, y = proportion, fill = as.factor(n_siblings))) +
geom_col(aes(alpha = RACE)) +
geom_hline(yintercept = 0, color = "black", size = 0.5) +
facet_grid(birth_range ~ YEAR, scales = "free_y") +
coord_flip() +
scale_y_continuous(
labels = function(x) abs(x),
limits = function(x) c(-max(abs(x)), max(abs(x)))
) +
scale_x_continuous(breaks = 0:12, labels = c(0:11, "12+")) +
scale_fill_manual(values = my_colors) +
scale_alpha_manual(values = c("White" = 0.7, "Black/African American" = 1)) +
labs(
title = "Distribution of Number of Siblings by Census Year, Race, and Birth Range",
x = "Number of Siblings",
y = "Proportion",
fill = "Number of Siblings",
caption = "White population shown on left (negative values), Black/African American on right (positive values)\nProportions normalized within each birth range, race, and census year\nFootnote: The category '12+' includes individuals with 12 or more siblings."
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14, hjust = 0.5),
axis.text.y = element_text(size = 8),
strip.text = element_text(size = 10),
legend.position = "none",
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank()
)
After creating the plot, examine it carefully:
Repeat the model fitting process we performed for the children distribution, this time using the sibling distribution data.
Prepare the Sibling Data Use the sibling distribution data you
calculated earlier (df_sibling_proportions
).
Fit Models For each combination of RACE, YEAR, and birth_range, fit the following distributions:
Use the same R functions and packages as in the children distribution analysis.
Compare Model Fits Use AIC (Akaike Information Criterion) to compare the fits of different models for each group.
Identify Best-Fitting Models Determine which model fits best for each combination of RACE, YEAR, and birth_range.
Analyze Patterns
Visualize Results Create a summary plot showing the best-fitting models across years and birth ranges for each race, similar to the one created for the children distribution.
Interpret Findings
Analyze the stability of sibling distributions across cohorts, similar to the analysis performed for children.
Use the sibling distribution data
(df_sibling_proportions
).
For each combination of RACE and birth_range:
Create a summary table showing:
Visualize stability:
Interpret results:
Create a visualization showing how sibling distributions change across census years for different races and birth ranges.
Use the sibling distribution data
(df_sibling_proportions
).
Create a multi-panel plot:
Use ggplot2
to create the plot:
ggplot(df_sibling_proportions, aes(x = n_siblings, y = proportion, color = factor(YEAR))) +
geom_line() +
facet_grid(RACE ~ birth_range) +
labs(title = "Sibling Distribution Across Census Years",
x = "Number of Siblings", y = "Proportion", color = "Census Year") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Remember to reference your findings from the children distribution analysis when discussing the results, highlighting any notable similarities or differences between the two analyses.
sessionInfo()