calculate_goat_herd_growth <- function(
initial_females = 54,
initial_males = 2,
years = 10,
mortality_rate = 0.05,
breeding_age = 1,
pregnancy_rate = 0.8,
kids_per_birth = 1.5,
female_kid_ratio = 0.5
) {
# Create sequence of years
simulation_years <- seq(0, years)
# Initialize population data
population_data <- tibble(
year = 0,
age = 0,
females = initial_females,
males = initial_males,
fertility_rate = pregnancy_rate * kids_per_birth
)
# Iterate through years using a for loop instead of accumulate
for(current_year in 1:years) {
# Age existing population and apply mortality
aged_population <- population_data %>%
filter(year == current_year - 1) %>%
mutate(
year = current_year,
age = age + 1,
females = floor(females * (1 - mortality_rate)),
males = floor(males * (1 - mortality_rate))
)
# Calculate breeding females
breeding_females <- aged_population %>%
filter(age >= breeding_age) %>%
summarise(total = sum(females)) %>%
pull(total)
# Calculate new births
total_new_kids <- breeding_females * pregnancy_rate * kids_per_birth
new_births <- tibble(
year = current_year,
age = 0,
females = floor(total_new_kids * female_kid_ratio),
males = floor(total_new_kids * (1 - female_kid_ratio)),
)
# Combine aged population with new births
population_data <- bind_rows(
population_data,
aged_population,
new_births
)
}
# Create yearly summary
yearly_summary <- population_data %>%
group_by(year) %>%
summarise(
Total_Population = sum(females + males),
Females = sum(females),
Males = sum(males),
New_Kids = sum(if_else(age == 0, females + males, 0)),
Deaths = floor((sum(females) + sum(males)) * mortality_rate),
.groups = "drop"
) %>%
mutate(
Growth_Rate = (Total_Population / lag(Total_Population) - 1) * 100,
Female_Ratio = Females / Total_Population * 100
)
# Create age structure summary
age_structure <- population_data %>%
group_by(year, age) %>%
summarise(
females = sum(females),
males = sum(males),
total = females + males,
.groups = "drop"
)
# Create visualizations
population_plot <- yearly_summary %>%
ggplot(aes(x = year)) +
geom_line(aes(y = Total_Population, color = "Total")) +
geom_line(aes(y = Females, color = "Females")) +
geom_line(aes(y = Males, color = "Males")) +
labs(
title = "Goat Herd Population Growth",
y = "Number of Goats",
color = "Population Type"
) +
theme_minimal()
age_pyramid <- age_structure %>%
filter(year == max(year)) %>%
ggplot(aes(x = age)) +
geom_col(aes(y = females, fill = "Females")) +
geom_col(aes(y = -males, fill = "Males")) +
coord_flip() +
labs(
title = "Final Year Age Structure",
x = "Age",
y = "Population",
fill = "Sex"
) +
theme_minimal()
# Return results
list(
population_data = population_data,
yearly_summary = yearly_summary,
age_structure = age_structure,
population_plot = population_plot,
age_pyramid = age_pyramid
)
}
results <- calculate_goat_herd_growth()
# View results
print("Yearly Summary:")
## [1] "Yearly Summary:"
print(results$yearly_summary)
## # A tibble: 11 × 8
## year Total_Population Females Males New_Kids Deaths Growth_Rate Female_Ratio
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 56 54 2 56 2 NA 96.4
## 2 1 112 81 31 60 5 100 72.3
## 3 2 194 121 73 90 9 73.2 62.4
## 4 3 315 180 135 134 15 62.4 57.1
## 5 4 494 268 226 200 24 56.8 54.3
## 6 5 767 403 364 302 38 55.3 52.5
## 7 6 1181 609 572 456 59 54.0 51.6
## 8 7 1807 921 886 690 90 53.0 51.0
## 9 8 2757 1395 1362 1046 137 52.6 50.6
## 10 9 4195 2113 2082 1584 209 52.2 50.4
## 11 10 6379 3204 3175 2402 318 52.1 50.2
Goat Growth
# Display plots
print(results$population_plot)
print(results$age_pyramid)
Goat Decline - current status
calculate_goat_herd_growth <- function(
initial_females = 54,
initial_males = 2,
years = 10,
mortality_rate = 0.1,
breeding_age = 1,
pregnancy_rate = 0.2,
kids_per_birth = 1,
female_kid_ratio = 0.5
) {
# Create sequence of years
simulation_years <- seq(0, years)
# Initialize population data
population_data <- tibble(
year = 0,
age = 0,
females = initial_females,
males = initial_males,
fertility_rate = pregnancy_rate * kids_per_birth
)
# Iterate through years using a for loop instead of accumulate
for(current_year in 1:years) {
# Age existing population and apply mortality
aged_population <- population_data %>%
filter(year == current_year - 1) %>%
mutate(
year = current_year,
age = age + 1,
females = floor(females * (1 - mortality_rate)),
males = floor(males * (1 - mortality_rate))
)
# Calculate breeding females
breeding_females <- aged_population %>%
filter(age >= breeding_age) %>%
summarise(total = sum(females)) %>%
pull(total)
# Calculate new births
total_new_kids <- breeding_females * pregnancy_rate * kids_per_birth
new_births <- tibble(
year = current_year,
age = 0,
females = floor(total_new_kids * female_kid_ratio),
males = floor(total_new_kids * (1 - female_kid_ratio)),
)
# Combine aged population with new births
population_data <- bind_rows(
population_data,
aged_population,
new_births
)
}
# Create yearly summary
yearly_summary <- population_data %>%
group_by(year) %>%
summarise(
Total_Population = sum(females + males),
Females = sum(females),
Males = sum(males),
New_Kids = sum(if_else(age == 0, females + males, 0)),
Deaths = floor((sum(females) + sum(males)) * mortality_rate),
.groups = "drop"
) %>%
mutate(
Growth_Rate = (Total_Population / lag(Total_Population) - 1) * 100,
Female_Ratio = Females / Total_Population * 100
)
# Create age structure summary
age_structure <- population_data %>%
group_by(year, age) %>%
summarise(
females = sum(females),
males = sum(males),
total = females + males,
.groups = "drop"
)
# Create visualizations
population_plot <- yearly_summary %>%
ggplot(aes(x = year)) +
geom_line(aes(y = Total_Population, color = "Total")) +
geom_line(aes(y = Females, color = "Females")) +
geom_line(aes(y = Males, color = "Males")) +
labs(
title = "Goat Herd Population Growth",
y = "Number of Goats",
color = "Population Type"
) +
theme_minimal()
age_pyramid <- age_structure %>%
filter(year == max(year)) %>%
ggplot(aes(x = age)) +
geom_col(aes(y = females, fill = "Females")) +
geom_col(aes(y = -males, fill = "Males")) +
coord_flip() +
labs(
title = "Final Year Age Structure",
x = "Age",
y = "Population",
fill = "Sex"
) +
theme_minimal()
# Return results
list(
population_data = population_data,
yearly_summary = yearly_summary,
age_structure = age_structure,
population_plot = population_plot,
age_pyramid = age_pyramid
)
}
results <- calculate_goat_herd_growth()
# View results
print("Yearly Summary:")
## [1] "Yearly Summary:"
print(results$yearly_summary)
## # A tibble: 11 × 8
## year Total_Population Females Males New_Kids Deaths Growth_Rate Female_Ratio
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 56 54 2 56 5 NA 96.4
## 2 1 57 52 5 8 5 1.79 91.2
## 3 2 57 50 7 8 5 0 87.7
## 4 3 56 47 9 8 5 -1.75 83.9
## 5 4 54 44 10 8 5 -3.57 81.5
## 6 5 48 39 9 6 4 -11.1 81.2
## 7 6 43 35 8 6 4 -10.4 81.4
## 8 7 36 30 6 4 3 -16.3 83.3
## 9 8 29 25 4 4 2 -19.4 86.2
## 10 9 22 20 2 2 2 -24.1 90.9
## 11 10 18 17 1 2 1 -18.2 94.4
Goat Decline
# Display plots
print(results$population_plot)
