Saskatchewan Crop Production
Graphs of crop production in Saskatchewan using STATCAN data
Data
Prepare Data
# devtools::install_github("derekmichaelwright/agData")
library(agData)
library(treemapify)
library(gganimate)
<- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: STATCAN"
myCaption #
<- agData_STATCAN_Crops %>% filter(Area == "Saskatchewan")
d1 <- agData_STATCAN_FarmLand_Use %>% filter(Area == "Saskatchewan") d2
PDF - All Crops
figures_crops_saskatchewan_statcan.pdf
# Prep data
<- c("darkgreen", "darkorange", "darkred",
myColors "antiquewhite4", "steelblue", "darkblue")
<- c("Area Seeded", "Area Harvested", "Production",
myMeasures "Yield", "Average Farm Price", "Total Farm Value")
<- d1 %>%
xx mutate(Measurement = factor(Measurement, levels = myMeasures),
Value = ifelse(Measurement != "Yield",
/ 1000000, Value / 1000),
Value Unit = plyr::mapvalues(Unit, c("Hectares", "Tonnes", "kg/ha"),
c("Million Hectares", "Million Tonnes", "Tonnes/ Hectare")))
<- unique(xx$Item)
myCrops # Plot
pdf("figures_crops_saskatchewan_statcan.pdf", width = 10, height = 6)
for(i in myCrops) {
<- xx %>% filter(Item == i)
xi print(ggplot(xi, aes(x = Year, y = Value, color = Measurement)) +
geom_line(size = 1.5, alpha = 0.7) +
facet_wrap(. ~ Measurement, scales = "free_y", ncol = 3) +
scale_color_manual(values = myColors) +
scale_x_continuous(breaks = seq(1920, 2020, by = 20) ) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = i, y = NULL, x = NULL, caption = myCaption) )
}dev.off()
1908 Vs. 1961 Vs. 2020
# Create function to determine top crops
<- function(measurement, years) {
cropList # Prep data
<- agData_STATCAN_Crops %>%
xx filter(Measurement == measurement, Year %in% years,
== "Saskatchewan") %>%
Area arrange(desc(Value)) %>%
pull(Item) %>% unique() %>% as.character()
xx }
Production
# Prep data
<- cropList(measurement = "Production", years = c(2020, 1961, 1908))
myCrops <- d1 %>%
xx filter(Measurement == "Production", Item %in% myCrops,
%in% c(2020, 1961, 1908) ) %>%
Year mutate(Item = factor(Item, levels = myCrops) )
# Plot
<- ggplot(xx, aes(x = Item, y = Value / 1000000, fill = Item)) +
mp geom_col(color = "Black", alpha = 0.7) +
facet_grid(Year ~ .) +
scale_fill_manual(values = agData_Colors) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Saskatchewan - Crop Production",
y = "Million Tonnes", x = NULL, caption = myCaption)
ggsave("crops_saskatchewan_01.png", mp, width = 7, height = 5)
Area Seeded
# Prep data
<- cropList(measurement = "Area Seeded", years = c(2020, 1961, 1908))
myCrops <- d1 %>%
xx filter(Measurement == "Area Seeded", Item %in% myCrops,
%in% c(2020, 1961, 1908) ) %>%
Year mutate(Item = factor(Item, levels = myCrops) )
# Plot
<- ggplot(xx, aes(x = Item, y = Value / 1000000, fill = Item)) +
mp geom_col(color = "Black", alpha = 0.7) +
facet_grid(Year ~ .) +
scale_fill_manual(values = c("antiquewhite4", agData_Colors)) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Saskatchewan - Area Seeded", x = NULL,
y = "Million Hectares", caption = myCaption)
ggsave("crops_saskatchewan_02.png", mp, width = 7, height = 5)
Yields
# Prep data
<- cropList(measurement = "Yield", years = c(2020, 1961, 1908))[-1]
myCrops <- d1 %>%
xx filter(Measurement == "Yield", Item %in% myCrops,
%in% c(2020, 1961, 1908) ) %>%
Year mutate(Item = factor(Item, levels = myCrops) )
# Plot
<- ggplot(xx, aes(x = Item, y = Value / 1000, fill = Item)) +
mp geom_col(color = "Black", alpha = 0.7) +
facet_grid(Year ~ .) +
scale_fill_manual(values = agData_Colors) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Saskatchewan - Yield", x = NULL,
y = "Tonnes / Hectare", caption = myCaption)
ggsave("crops_saskatchewan_03.png", mp, width = 7, height = 5)
Bar Chart Racer
Production
# Prep data
<- d1 %>%
xx filter(!Item %in% c("Hemp","Sugar beets"),
== "Production") %>%
Measurement group_by(Item) %>%
mutate(Value = movingAverage(Value, n = 3)) %>%
group_by(Year) %>%
arrange(Year, -Value) %>%
mutate(Rank = 1:n()) %>%
filter(Rank < 15) %>%
arrange(desc(Year)) %>%
mutate(Item = factor(Item, levels = unique(.$Item)))
# Plot
<- ggplot(xx, aes(xmin = 0, xmax = Value / 1000000,
mp ymin = Rank - 0.45, ymax = Rank + 0.45, y = Rank,
fill = Item)) +
geom_rect(alpha = 0.7, color = "black") +
scale_fill_manual(values = agData_Colors) +
scale_x_continuous(limits = c(-4,max(xx$Value)/1000000),
breaks = seq(0, 18, by = 4),
minor_breaks = seq(0, 18, by = 2)) +
geom_text(aes(label = Item), col = "black", hjust = 1, x = -0.2) +
scale_y_reverse() +
theme_agData(legend.position = "none",
axis.text.y = element_blank(),
axis.ticks = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank()) +
labs(title = paste("Saskatchewan - Production -", "{frame_time}"),
x = "Million Tonnes", y = NULL, caption = myCaption) +
transition_time(Year)
anim_save("crops_saskatchewan_gif_01.gif", mp,
nframes = 600, fps = 15, end_pause = 60,
width = 900, height = 600, res = 150)
Seeded Area
# Prep data
<- d1 %>%
xx filter(Measurement == "Area Seeded") %>%
group_by(Year) %>%
arrange(Year, -Value) %>%
mutate(Rank = 1:n()) %>%
filter(Rank < 15) %>%
arrange(desc(Year)) %>%
mutate(Item = factor(Item, levels = unique(.$Item)))
# Plot
<- ggplot(xx, aes(xmin = 0, xmax = Value / 1000000,
mp ymin = Rank - 0.45, ymax = Rank + 0.45, y = Rank,
fill = Item)) +
geom_rect(alpha = 0.7, color = "black") +
scale_fill_manual(values = agData_Colors) +
scale_x_continuous(limits = c(-2,max(xx$Value)/1000000),
breaks = seq(0, 10, by = 2),
minor_breaks = seq(0, 10, by = 1)) +
geom_text(aes(label = Item), col = "black", hjust = 1, x = -0.1) +
scale_y_reverse() +
theme_agData(legend.position = "none",
axis.text.y = element_blank(),
axis.ticks = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank()) +
labs(title = paste("Saskatchewan - Area Harvested -", "{frame_time}"),
x = "Million Hectares", y = NULL, caption = myCaption) +
transition_time(Year)
anim_save("crops_saskatchewan_gif_02.gif", mp,
nframes = 600, fps = 15, end_pause = 60,
width = 900, height = 600, res = 150)
Production of Major Crops
# Prep data
<- cropList(measurement = "Production", years = 2020)[c(1:8)]
myCrops <- c(myCrops, "Other")
myCrops <- d1 %>% filter(Measurement == "Production", Item %in% myCrops)
x1 <- d1 %>% filter(Measurement == "Production", !Item %in% myCrops) %>%
x2 group_by(Year) %>%
summarise(Value = sum(Value, na.rm = T)) %>%
ungroup() %>%
mutate(Item = "Other")
<- bind_rows(x1, x2) %>%
xx mutate(Item = factor(Item, levels = rev(myCrops)))
# Plot
<- ggplot(xx, aes(x = Year, y = Value / 1000000, fill = Item)) +
mp geom_col(alpha = 0.7, color = "black", lwd = 0.1) +
scale_fill_manual(name = NULL, values = agData_Colors[c(9:1)]) +
scale_x_continuous(breaks = seq(1910, 2020, by=10), expand = c(0.01,0)) +
guides(fill = guide_legend(override.aes = list(lwd = 0.4))) +
theme_agData() +
labs(title = "Saskatchewan - Crop Production", x = NULL,
y = "Million Tonnes", caption = myCaption)
ggsave("crops_saskatchewan_04.png", mp, width = 8, height = 4)
Production By Decade
# Prep data
<- cropList(measurement = "Production", years = 2020)[c(1:8)]
myCrops <- c(myCrops, "Other")
myCrops <- d1 %>% filter(Measurement == "Production", Item %in% myCrops)
x1 <- d1 %>% filter(Measurement == "Production", !Item %in% myCrops) %>%
x2 group_by(Year) %>%
summarise(Value = sum(Value, na.rm = T)) %>%
ungroup() %>%
mutate(Item = "Other")
<- bind_rows(x1, x2) %>%
xx mutate(Item = factor(Item, levels = rev(myCrops)),
Decade = floor(Year/10)*10)
<- xx %>% filter(Year >= 1910, Year <= 2020) %>%
x1 group_by(Item, Decade) %>%
summarise(Value = mean(Value, na.rm = T)) %>%
rename(Year=Decade) %>%
mutate(Year = paste0(Year, "'s"))
<- xx %>% filter(Year == 2021) %>%
x2 mutate(Year = as.character(Year))
<- bind_rows(x1, x2) %>%
xx mutate(Year = factor(Year))
# Plot
<- ggplot(xx, aes(x = Year, y = Value / 1000000, fill = Item)) +
mp geom_col(alpha = 0.7, color = "black", lwd = 0.2) +
scale_fill_manual(name = NULL, values = agData_Colors[c(9:1)]) +
guides(fill = guide_legend(override.aes = list(lwd = 0.4))) +
theme_agData() +
labs(title = "Saskatchewan - Crop Production",
y = "Million Tonnes", x = NULL, caption = myCaption)
mp
ggsave("crops_saskatchewan_05.png", mp, width = 8, height = 4)
Droughts
# Prep data
<- cropList(measurement = "Production", years = 2020)[c(1:8)]
myCrops <- c(myCrops, "Other")
myCrops <- c(1935,1936,1937,1938,1939, 1952,1953,1954,1955,1956,
myYears 1959,1960,1961,1962,1963, 1986,1987,1988,1989,1990,
2000,2001,2002,2003,2004, 2019,2020,2021,2022,2023)
<- c(rep(1:6, each = 5))
myGroups <- d1 %>% filter(Measurement == "Production", Item %in% myCrops)
x1 <- d1 %>% filter(Measurement == "Production", !Item %in% myCrops) %>%
x2 group_by(Year) %>%
summarise(Value = sum(Value, na.rm = T)) %>%
ungroup() %>%
mutate(Item = "Other")
<- bind_rows(x1, x2) %>%
xx filter(Year %in% myYears) %>%
mutate(Item = factor(Item, levels = rev(myCrops)),
Group = plyr::mapvalues(Year, myYears, myGroups))
# Plot
<- ggplot(xx, aes(x = Year, y = Value / 1000000, fill = Item)) +
mp geom_col(alpha = 0.7, color = "black", lwd = 0.3) +
facet_wrap(Group ~ . , ncol = 6, scales = "free") +
scale_fill_manual(name = NULL, values = agData_Colors[c(9:1)]) +
guides(fill = guide_legend(override.aes = list(lwd = 0.4))) +
theme_agData(axis.text.x = element_text(angle = 45, hjust = 1),
strip.text = element_blank()) +
labs(title = "Saskatchewan - Drought Years", x = NULL,
y = "Million Tonnes", caption = myCaption)
ggsave("crops_saskatchewan_06.png", mp, width = 8, height = 4)
2020 vs 2021
# Prep data
<- xx %>% filter(Year %in% c(2020, 2021)) %>%
xx mutate(Item = factor(Item, levels = myCrops),
Year = factor(Year))
# Plot
<- ggplot(xx, aes(x = Item, y = Value / 1000000,
mp fill = Item, alpha = Year)) +
geom_col(position = "dodge", color = "black") +
scale_fill_manual(values = agData_Colors, guide = F) +
scale_alpha_manual(name = NULL, values = c(0.7, 0.3)) +
theme_agData(legend.position = "bottom") +
labs(title = "Saskatchewan - Crop Production - 2020 vs. 2021",
y = "Million Tonnes", x = NULL, caption = myCaption)
ggsave("crops_saskatchewan_07.png", mp, width = 6, height = 4)
Yields 2020
# Prep data
<- cropList(measurement = "Yield", years = 2020)[-1]
myCrops <- d1 %>%
xx filter(Year == 2020, Measurement == "Yield", Item %in% myCrops) %>%
mutate(Item = factor(Item, levels = myCrops) )
# Plot
<- ggplot(xx, aes(x = Item, y = Value / 1000, fill = Item)) +
mp geom_col(color = "Black", alpha = 0.7) +
facet_grid(Year ~ .) +
scale_fill_manual(values = agData_Colors) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Saskatchewan - Crop yields",
y = "Tonnes / Hectare", x = NULL, caption = myCaption)
ggsave("crops_saskatchewan_08.png", mp, width = 6, height = 5)
Per Person
# Prep data
<- agData_STATCAN_Population %>%
pp filter(Month == 1, Area == "Saskatchewan", Year == 2020) %>%
pull(Value)
<- cropList(measurement = "Production", years = 2020)
myCrops <- d1 %>%
xx filter(Year == 2020, Item %in% myCrops,
== "Production") %>%
Measurement mutate(Item = factor(Item, levels = myCrops),
PerPerson = Value / pp) %>%
filter(PerPerson > 0.1)
# Plot
<- ggplot(xx, aes(x = Item, y = PerPerson, fill = Item)) +
mp geom_col(color = "Black", alpha = 0.7) +
geom_label(aes(label = round(PerPerson,1)), vjust = -0.15, fill = "White",
size = 3, label.padding = unit(0.15, "lines")) +
facet_grid(Year~.) +
scale_y_continuous(limits = c(0,15), expand = c(0,0)) +
scale_fill_manual(values = agData_Colors) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Saskatchewan - Crop Production Per Person",
y = "1000 kg", x = NULL, caption = myCaption)
ggsave("crops_saskatchewan_09.png", mp, width = 6, height = 4)
All Crops
Area Seeded
# Prep data
<- d1 %>% filter(Measurement == "Area Seeded")
xx <- unique(c(cropList(measurement = "Area Seeded", years = 2017),
myCrops as.character(xx$Item)))
<- xx %>% mutate(Item = factor(Item, levels = myCrops))
xx # Plot
<- ggplot(xx, aes(x = Year, y = Value / 1000000, color = Item)) +
mp geom_line(alpha = 0.7) +
facet_wrap(Item ~ ., ncol = 6) +
scale_color_manual(values = agData_Colors) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Saskatchewan Crops - Area Seeded",
y = "Million Hectares", x = NULL, caption = myCaption)
ggsave("crops_saskatchewan_10.png", mp, width = 6, height = 5)
Production
# Prep data
<- d1 %>% filter(Measurement == "Production")
xx <- unique(c(cropList(measurement = "Production", years = 2017),
myCrops as.character(xx$Item)))
<- xx %>% mutate(Item = factor(Item, levels = myCrops))
xx # Plot
<- ggplot(xx, aes(x = Year, y = Value / 1000000, color = Item)) +
mp geom_line(alpha = 0.7) +
facet_wrap(Item ~ ., ncol = 6) +
scale_color_manual(values = agData_Colors) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Saskatchewan Crops - Production",
y = "Million Hectares", x = NULL, caption = myCaption)
ggsave("crops_saskatchewan_11.png", mp, width = 6, height = 5)
Treemap
# Prep data
<- d1 %>% filter(Year == 2020, Measurement == "Area Seeded") %>%
xx arrange(desc(Value)) %>%
mutate(Item = factor(Item, levels = unique(.$Item)))
# Plot
<- ggplot(xx, aes(area = Value, fill = Item, label = Item)) +
mp geom_treemap(color = "black", alpha = 0.7, size = 1.5) +
geom_treemap_text(place = "centre", grow = T, color = "white") +
scale_fill_manual(values = agData_Colors) +
theme_agData(legend.position = "none") +
labs(title = "Saskatchewan Cropland",
subtitle = "Area Seeded 2020", caption = myCaption)
ggsave("crops_saskatchewan_12.png", mp, width = 6, height = 4)