Anaylsis of Births in the United States

This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Cmd+Shift+Enter.

library(dplyr)
library(ggplot2)

data <- read.csv("~/Downloads/DIDA325/2016_2021_US_BIRTHS.csv")

average_births <- data %>%
  group_by(Education.Level.of.Mother) %>%
  summarize(Average_Births = mean(Number.of.Births))

Summary of Births Table

Using the data set, the variables applied are the Education Level, the Number of Births, and the Average age of Mother in years in order to understand the average Education Level of Mothers and the Number of Births associated

summary_births <- data %>%
  select(c(Education.Level.Code, Number.of.Births, Average.Age.of.Mother..years.))
mean1 <- summary_births %>% summarise(across(everything(), mean, na.rm=TRUE))

Warning: There was 1 warning in `summarise()`.
ℹ In argument: `across(everything(), mean, na.rm = TRUE)`.
Caused by warning:
! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
Supply arguments directly to `.fns` through an anonymous function instead.

  # Previously
  across(a:b, mean, na.rm = TRUE)

  # Now
  across(a:b, \(x) mean(x, na.rm = TRUE))
This warning is displayed once every 8 hours.
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.

sd1 <- summary_births %>% summarise(across(everything(), sd, na.rm=TRUE))
min1 <- summary_births %>% summarise(across(everything(), min, na.rm=TRUE))
max1 <- summary_births %>% summarise(across(everything(), max, na.rm=TRUE))

table <- rbind(mean1, sd1, min1, max1)

rownames(table) <- c("Mean", "Standard Deviation", "Minimum", "Maximum")

table <- t(table)

options(scipen = 999)

table <- table %>% 
  as.data.frame %>% 
  mutate_if(is.numeric, round, digits=2)

library(kableExtra)

Attaching package: ‘kableExtra’

The following object is masked from ‘package:dplyr’:

    group_rows

table %>%
kbl(caption = "<center><strong>Summary Table of Education, Birth rate, and Average Age of Mothers</strong></center>",
    format = "html") %>%
  kable_classic_2("striped", full_width = F)

Summary Table of Education, Birth rate, and Average Age of Mothers

	Mean	Standard Deviation	Minimum	Maximum
Education.Level.Code	3.03	4.73	-9.0	8.0
Number.of.Births	4115.44	6687.04	10.0	59967.0
Average.Age.of.Mother..years.	29.55	2.78	23.1	35.5

births <- data %>%
  select(c(Number.of.Births, Year))

Distribution of the Number of Births

Using the geom_histogram method we analyze the number of births in relation to the Year

library(ggplot2)
ggplot(data, aes(x = Number.of.Births))+
  geom_histogram(fill = "skyblue", color = "white", bins = 6)+
  theme_minimal()+
  labs(title = "Distribution of the Number of Births", bold = T)

Analysis of Education in relation to Number of Births

This table is created to analyze how the number of births changes based on the Education Level Code (years in school). The aim was to understand at what point in a woman’s life was she the most likely to give birth. The select, group_by, and summarise method used to create the table.

library(kableExtra)
education <- data %>% 
  select(Education.Level.of.Mother, Education.Level.Code, Year, Number.of.Births, Average.Age.of.Mother..years.) %>% 
  group_by(Education.Level.of.Mother) %>% 
  summarise(across(Number.of.Births:Average.Age.of.Mother..years., mean, na.rm=T)) %>% 
  mutate_if(is.numeric, round, digits=2)

type <- education
#Set conditional cell specification
type$Number.of.Births = cell_spec(type$Number.of.Births, background = ifelse(type$Number.of.Births > 7000.00, "magenta", "pink"), color = "black", bold = T)
type$Average.Age.of.Mother..years. = cell_spec(type$Average.Age.of.Mother..years., background = ifelse(type$Average.Age.of.Mother..years. >30.00, "skyblue", "lavender"), color = "black", bold = T)
#print table
type %>%
  kbl(caption = "<center><strong>Education and Births </strong></center>",
    format = "html" , escape = F, align = "c") %>%
  kable_classic_2("striped", full_width = F)

Education and Births

Education.Level.of.Mother	Number.of.Births	Average.Age.of.Mother..years.
8th grade or less	1158.25	29.41
9th through 12th grade with no diploma	3409.12	25.06
Associate degree (AA, AS)	3051.8	29.86
Bachelor's degree (BA, AB, BS)	7603.24	31.23
Doctorate (PhD, EdD) or Professional Degree (MD, DDS, DVM, LLB, JD)	1025.66	33.7
High school graduate or GED completed	9437.77	26.49
Master's degree (MA, MS, MEng, MEd, MSW, MBA)	3531.12	32.78
Some college credit, but not a degree	7230.83	28.07
Unknown or Not Stated	520.71	29.36

NA

Analysis of Education Level vs Number of Births

library(ggplot2)
ggplot(education) + 
  geom_point(aes(x = Education.Level.of.Mother, y = Number.of.Births), color = "blue") + 
  labs(y = "# of Births", x = "Education", 
       title = "Education Level of Mother vs Number of Births") + theme(axis.text.x = element_text(angle = 45, hjust = 1))

Regression Analysis of Year vs Number of Births and Number of Births vs Education Level

library(ggplot2)
library(cowplot)
a <- ggplot(data) +
  geom_point(aes(x = Year, y = Number.of.Births, color = Average.Age.of.Mother..years.))+
  geom_smooth(method = "lm", aes(x = Year, y = Number.of.Births))+
  theme_minimal()+
  labs(title = "Year vs Number of Births")

b <- ggplot(data)+
  geom_point(aes(x = Number.of.Births , y = Education.Level.Code, color = Average.Age.of.Mother..years.))+
  geom_smooth(method = "lm", aes(x = Number.of.Births, y = Education.Level.Code))+
  theme_minimal()+
  labs(title = "Number of Births vs Education Level Code")

plot_grid(a, b, nrow = 1)

`geom_smooth()` using formula = 'y ~ x'`geom_smooth()` using formula = 'y ~ x'