library(ggplot2)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(pwr)
library(scales)
library(tidyr)
library(RColorBrewer)
library(readr)
##
## Attaching package: 'readr'
## The following object is masked from 'package:scales':
##
## col_factor
# Plot 1: Observations of life events over time
# Create the dataset including total observations per event type per year
data <- data.frame(
Period = c(1990, 1995, 2000, 2005, 2010, 2015, 2020),
Separation = c(773, 1385, 2286, 2241, 2668, 2744, 1373),
Total_Separation = c(11011, 14040, 21569, 21882, 70108, 79902, 45224),
Unemployed = c(1715, 1914, 2396, 1922, 2174, 1814, 713),
Total_Unemployed = c(61627, 68473, 115180, 104532, 137778, 130251, 69668),
Partner_Died = c(242, 272, 408, 427, 392, 398, 245),
Total_Partner_Died = c(62778, 69127, 115183, 104534, 123610, 128204, 69803),
New_Partner = c(1741, 1754, 2825, 2790, 3172, 3398, 1481),
Total_New_Partner = c(14000, 18470, 27606, 27653, 82585, 95013, 54698),
Cohabitation_New = c(1362, 1196, 1600, 1475, 1800, 1890, 1235),
Total_Cohabitation_New = c(14722, 17876, 24469, 24311, 76266, 87439, 49115)
)
# Rename event variables for better readability
event_labels <- c(
"Separation" = "Separation",
"Unemployed" = "Unemployed",
"Partner_Died" = "Partner Passed Away",
"New_Partner" = "New Partnership",
"Cohabitation_New" = "Started Cohabiting"
)
# Convert to long format for absolute counts
df_melted_abs <- pivot_longer(data,
cols = c("Separation", "Unemployed", "Partner_Died", "New_Partner", "Cohabitation_New"),
names_to = "Event", values_to = "Count")
# Convert to long format for totals
df_melted_total <- pivot_longer(data,
cols = c("Total_Separation", "Total_Unemployed", "Total_Partner_Died",
"Total_New_Partner", "Total_Cohabitation_New"),
names_to = "Event", values_to = "Total")
# Standardize event names to match between dataframes
df_melted_total$Event <- gsub("Total_", "", df_melted_total$Event)
# Merge absolute counts with total counts per year
df_final <- left_join(df_melted_abs, df_melted_total, by = c("Period", "Event"))
# Compute relative count
df_final <- df_final %>% mutate(Relative_Count = 100 * Count / Total)
# Apply readable names to Event variable
df_final$Event <- factor(df_final$Event, levels = names(event_labels), labels = event_labels)
# Sort legend order by average absolute counts
avg_counts <- df_final %>%
group_by(Event) %>%
summarise(Avg_Absolute = mean(Count, na.rm = TRUE),
Avg_Relative = mean(Relative_Count, na.rm = TRUE)) %>%
arrange(desc(Avg_Absolute)) # Sorting in descending order of absolute counts
df_final$Event <- factor(df_final$Event, levels = avg_counts$Event) # Reorder legend
# Plot absolute counts
ggplot(df_final, aes(x = Period, y = Count, color = Event)) +
geom_line(size = 1) +
geom_point(size = 2) +
labs(title = "Absolute Counts of Life Events Over Time", x = "Period", y = "Absolute Count") +
scale_color_manual(values = RColorBrewer::brewer.pal(5, "Set1")) +
scale_x_continuous(breaks = seq(min(df_final$Period), max(df_final$Period), by = 5)) +
theme_minimal() +
theme(
plot.title = element_text(size = 24, face = "bold", hjust = 0.5), # Increase title size
axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title.x = element_text(size = 20, face = "bold", hjust = 0.5),
axis.title.y = element_text(size = 20, face = "bold", hjust = 0.5),
axis.line = element_line(size = 1.2),
legend.key.spacing.y = unit(1, "cm"),
legend.text = element_text(size = 18),
legend.title = element_blank(),
legend.position = "right"
)
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Sort legend order by average relative counts for the second plot
df_final$Event <- factor(df_final$Event, levels = avg_counts$Event[order(-avg_counts$Avg_Relative)])
# Plot relative counts
ggplot(df_final, aes(x = Period, y = Relative_Count, color = Event)) +
geom_line(size = 1) +
geom_point(size = 2) +
labs(title = "Relative Occurrence of Life Events Over Time", x = "Period", y = "% of Observations Experiencing the Event") +
scale_x_continuous(breaks = seq(min(df_final$Period), max(df_final$Period), by = 5)) +
scale_color_manual(values = RColorBrewer::brewer.pal(5, "Set1")) +
theme_minimal() +
theme(
plot.title = element_text(size = 24, face = "bold", hjust = 0.5), # Increase title size
axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title.x = element_text(size = 20, face = "bold", hjust = 0.5),
axis.title.y = element_text(size = 20, face = "bold", hjust = 0.5),
axis.line = element_line(size = 1.2),
legend.key.spacing.y = unit(1, "cm"),
legend.text = element_text(size = 18),
legend.title = element_blank(),
legend.position = "right"
)
# Plot 2: Meta-analysis
# Read the simplified CSV file
meta_analysis <- read_csv("Meta Analysis - Final Plotting.csv")
## Rows: 42 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Event
## dbl (3): Period, Indexed Effect, Indexed SE
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Ensure numeric formatting
meta_analysis <- meta_analysis %>%
mutate(
Period = as.numeric(Period),
`Indexed Effect` = as.numeric(`Indexed Effect`),
`Indexed SE` = as.numeric(`Indexed SE`),
Event = as.character(Event) # Ensure Event is a categorical variable
)
# Separate meta-average from individual events
meta_average_rows <- meta_analysis %>% filter(Event == "Meta-Average")
event_rows <- meta_analysis %>% filter(Event != "Meta-Average")
# Compute confidence intervals
event_rows <- event_rows %>%
mutate(
CI_Lower = `Indexed Effect` - 1.96 * `Indexed SE`,
CI_Upper = `Indexed Effect` + 1.96 * `Indexed SE`
)
meta_average_rows <- meta_average_rows %>%
mutate(
CI_Lower = `Indexed Effect` - 1.96 * `Indexed SE`,
CI_Upper = `Indexed Effect` + 1.96 * `Indexed SE`
)
# Order legend by highest average indexed effect
label_order <- event_rows %>%
group_by(Event) %>%
summarize(Mean_Index = mean(`Indexed Effect`, na.rm = TRUE)) %>%
arrange(desc(Mean_Index)) %>%
pull(Event)
# Ensure Meta-Average is part of the Label factor
event_rows$Event <- factor(event_rows$Event, levels = label_order)
meta_analysis$Event <- factor(meta_analysis$Event, levels = c("Meta-Average", label_order))
# Define custom colors: Black for Meta-Average, others from Set1
custom_colors <- c("Meta-Average" = "black", setNames(RColorBrewer::brewer.pal(length(label_order), "Set1"), label_order))
# Define custom shapes: Circle for events (16), Square for Meta-Average (15)
custom_shapes <- c("Meta-Average" = 15, setNames(rep(16, length(label_order)), label_order))
# Plot 3: All Events, with Meta-Average
ggplot() +
# Plot event trends
geom_line(data = event_rows, aes(x = Period, y = `Indexed Effect`, color = Event, group = Event), linewidth = 1) +
geom_point(data = event_rows, aes(x = Period, y = `Indexed Effect`, color = Event, shape = Event), size = 2) +
# Plot meta-average WITHIN the color mapping, keeping it black
geom_line(data = meta_average_rows, aes(x = Period, y = `Indexed Effect`, color = Event),
linewidth = 1.2, linetype = "dashed") +
geom_point(data = meta_average_rows, aes(x = Period, y = `Indexed Effect`, color = Event, shape = Event),
size = 4) + # Squares for meta-average
geom_ribbon(data = meta_average_rows, aes(x = Period, ymin = CI_Lower, ymax = CI_Upper),
fill = "gray", alpha = 0.3) +
# Add reference line at y = 1
geom_hline(yintercept = 1, linetype = "dashed", color = "gray", size = 1) +
# Annotations on the far left (1990)
annotate("text", x = min(meta_analysis$Period) - 0.5, y = 1,
label = " ----> Stronger Effect", angle = 90, hjust = 0, vjust = 0, size = 6) +
annotate("text", x = min(meta_analysis$Period) - 0.5, y = 0.6,
label = "Weaker Effect <----", angle = 90, hjust = 0, vjust = 0, size = 6) +
# Formatting
scale_x_continuous(breaks = seq(min(meta_analysis$Period), max(meta_analysis$Period), by = 5)) +
theme_minimal() +
labs(
title = "Evolution of the effect of Life Events with Meta-Average",
x = "Year",
y = "Indexed Effect Size",
color = "Event",
shape = "Event"
) +
theme(
plot.title = element_text(size = 24, face = "bold", hjust = 0.5), # Increase title size
axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title.x = element_text(size = 20, face = "bold", hjust = 0.5),
axis.title.y = element_text(size = 20, face = "bold", hjust = 0.5),
axis.line = element_line(size = 1.2),
legend.key.spacing.y = unit(1, "cm"),
legend.text = element_text(size = 18),
legend.title = element_blank(),
legend.position = "right"
) +
scale_color_manual(values = custom_colors) +
scale_shape_manual(values = custom_shapes) +
guides(
color = guide_legend(override.aes = list(size = 3, shape = 16)),
shape = guide_legend(override.aes = list(size = 3))
)
## Warning: Duplicated `override.aes` is ignored.
# Meta-analysis with 8-year bins
meta_analysis <- read_csv("Meta Analysis - Final Plotting (8-year).csv")
## Rows: 24 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Event
## dbl (3): Period, Indexed Effect, Indexed SE
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Ensure numeric formatting
meta_analysis <- meta_analysis %>%
mutate(
Period = as.numeric(Period),
`Indexed Effect` = as.numeric(`Indexed Effect`),
`Indexed SE` = as.numeric(`Indexed SE`),
Event = as.character(Event) # Ensure Event is a categorical variable
)
# Separate meta-average from individual events
meta_average_rows <- meta_analysis %>% filter(Event == "Meta-Average")
event_rows <- meta_analysis %>% filter(Event != "Meta-Average")
# Compute confidence intervals
event_rows <- event_rows %>%
mutate(
CI_Lower = `Indexed Effect` - 1.96 * `Indexed SE`,
CI_Upper = `Indexed Effect` + 1.96 * `Indexed SE`
)
meta_average_rows <- meta_average_rows %>%
mutate(
CI_Lower = `Indexed Effect` - 1.96 * `Indexed SE`,
CI_Upper = `Indexed Effect` + 1.96 * `Indexed SE`
)
# Order legend by highest average indexed effect
label_order <- event_rows %>%
group_by(Event) %>%
summarize(Mean_Index = mean(`Indexed Effect`, na.rm = TRUE)) %>%
arrange(desc(Mean_Index)) %>%
pull(Event)
# Ensure Meta-Average is part of the Label factor
event_rows$Event <- factor(event_rows$Event, levels = label_order)
meta_analysis$Event <- factor(meta_analysis$Event, levels = c("Meta-Average", label_order))
# Define custom colors: Black for Meta-Average, others from Set1
custom_colors <- c("Meta-Average" = "black", setNames(RColorBrewer::brewer.pal(length(label_order), "Set1"), label_order))
# Define custom shapes: Circle for events (16), Square for Meta-Average (15)
custom_shapes <- c("Meta-Average" = 15, setNames(rep(16, length(label_order)), label_order))
# Plot 3: All Events, with Meta-Average
ggplot() +
# Plot event trends
geom_line(data = event_rows, aes(x = Period, y = `Indexed Effect`, color = Event, group = Event), linewidth = 1) +
geom_point(data = event_rows, aes(x = Period, y = `Indexed Effect`, color = Event, shape = Event), size = 2) +
# Plot meta-average WITHIN the color mapping, keeping it black
geom_line(data = meta_average_rows, aes(x = Period, y = `Indexed Effect`, color = Event),
linewidth = 1.2, linetype = "dashed") +
geom_point(data = meta_average_rows, aes(x = Period, y = `Indexed Effect`, color = Event, shape = Event),
size = 4) + # Squares for meta-average
geom_ribbon(data = meta_average_rows, aes(x = Period, ymin = CI_Lower, ymax = CI_Upper),
fill = "gray", alpha = 0.3) +
# Add reference line at y = 1
geom_hline(yintercept = 1, linetype = "dashed", color = "gray", size = 1) +
# Annotations on the far left (1990)
annotate("text", x = min(meta_analysis$Period) - 0.5, y = 1,
label = " ----> Stronger Effect", angle = 90, hjust = 0, vjust = 0, size = 6) +
annotate("text", x = min(meta_analysis$Period) - 0.5, y = 0.65,
label = "Weaker Effect <----", angle = 90, hjust = 0, vjust = 0, size = 6) +
# Formatting
scale_x_continuous(breaks = seq(min(meta_analysis$Period), max(meta_analysis$Period), by = 5)) +
theme_minimal() +
labs(
title = "Evolution of the effect of Life Events with Meta-Average",
x = "Year",
y = "Indexed Effect Size",
color = "Event",
shape = "Event"
) +
theme(
plot.title = element_text(size = 24, face = "bold", hjust = 0.5), # Increase title size
axis.text.x = element_text(size = 14),
axis.text.y = element_text(size = 14),
axis.title.x = element_text(size = 20, face = "bold", hjust = 0.5),
axis.title.y = element_text(size = 20, face = "bold", hjust = 0.5),
axis.line = element_line(size = 1.2),
legend.key.spacing.y = unit(1, "cm"),
legend.text = element_text(size = 18),
legend.title = element_blank(),
legend.position = "right"
) +
scale_color_manual(values = custom_colors) +
scale_shape_manual(values = custom_shapes) +
guides(
color = guide_legend(override.aes = list(size = 3, shape = 16)),
shape = guide_legend(override.aes = list(size = 3))
)
## Warning: Duplicated `override.aes` is ignored.
# Plot 4: reconstructed LS alongside reported LS and GDP
# Load necessary library
library(dplyr)
# --- Step 1: GDP Data ---
gdp_data <- data.frame(
Period = c(1990, 1995, 2000, 2005, 2010, 2015, 2020),
Average_GDP = c(44378.28, 47210.38, 50783.71, 53499.50, 58082.25, 62159.35, 62350.42)
)
# --- Step 2: Life Satisfaction Data ---
lifesat_data <- data.frame(
Period = c(1990, 1995, 2000, 2005, 2010, 2015, 2020),
LifeSat = c(6.95721435546875, 6.901616096496582031, 7.003602981567382812,
6.952503681182861328, 7.238335609436035156, 7.423738956451416016,
7.474206924438476562)
)
# --- Step 3: Meta-Average Data ---
meta_avg_data <- data.frame(
Period = c(1990, 1995, 2000, 2005, 2010, 2015, 2020),
Meta_Average = c(1,
1.147920542,
1.178354502,
0.9841067346,
0.9789212228,
0.7748061071,
0.5931887347)
)
# --- Step 4: Merge All Data into One Table ---
final_data <- gdp_data %>%
left_join(lifesat_data, by = "Period") %>%
left_join(meta_avg_data, by = "Period")
LS_start <- final_data$LifeSat[1]
final_data <- final_data %>%
mutate(
Adjusted_LifeSat = LifeSat / Meta_Average, # Adjusted LS
GDP_Scaled_LS = (Average_GDP / Average_GDP[1]) * LS_start, # GDP scaled to match LS
Event_Effect_Index_Scaled = Meta_Average*LS_start # Index of life event effect sizes
)
ggplot(final_data, aes(x = Period)) +
# Life Satisfaction (LS) - Blue Solid Line & Points
geom_line(aes(y = LifeSat, color = "Life Satisfaction"), size = 1) +
geom_point(aes(y = LifeSat, color = "Life Satisfaction"), size = 3, shape = 16) +
# Reconstructed Life Satisfaction - Red Solid Line & Diamonds
geom_line(aes(y = Adjusted_LifeSat, color = "Reconstructed Life Satisfaction"), size = 1) +
geom_point(aes(y = Adjusted_LifeSat, color = "Reconstructed Life Satisfaction"), size = 3, shape = 5) +
# GDP Scaled to Adjusted LS - Light Gray Dashed Line
geom_line(aes(y = GDP_Scaled_LS, color = "GDP per capita"), size = 1, linetype = "dotdash") +
geom_point(aes(y = GDP_Scaled_LS, color = "GDP per capita"), size = 3, shape = 18) +
# Event Effect Index - Green Dashed Line
geom_line(aes(y = Event_Effect_Index_Scaled, color = "Life Event Effect Index"), size = 1, linetype = "dashed") +
geom_point(aes(y = Event_Effect_Index_Scaled, color = "Life Event Effect Index"), size = 3, shape = 15) +
# Format axes
scale_y_continuous(
name = "Life Satisfaction",
sec.axis = sec_axis(~ . / LS_start,
name = "Index 1990 = 1",
breaks = seq(0.5, 2, by = 0.25)) # More labels (0.5, 0.75, 1, 1.25, etc.)
) +
# Add a horizontal line at LS_start
# geom_hline(yintercept = LS_start, linetype = "dashed", color = "black", size = 1) +
# X-axis formatting
scale_x_continuous(breaks = final_data$Period) +
# Labels and Theme
labs(
title = "Adjusting Life Satisfaction for Rescaling",
x = "Period",
color = "Legend"
) +
# Styling for no background, axis lines, and no grid
theme_void() + # Start with a blank theme
theme(
panel.border = element_blank(),
plot.title = element_text(size = 24, face = "bold", hjust = 0.5),
axis.line.x = element_line(color = "black", size = 0.8),
axis.line.y = element_line(color = "black", size = 0.8),
axis.text.x = element_text(size = 16),
axis.title.x = element_text(size = 18),
axis.title.y = element_text(size = 18, angle = 90, hjust = 0.5, margin = margin(r = 15)),
axis.text.y = element_text(size = 16, margin = margin(r = 10)),
# panel.grid.major = element_line(color = "gray80", size = 0.5), # Major gridlines
legend.key = element_blank(),
legend.key.spacing.y = unit(1, "cm"),
legend.text = element_text(size = 20),
legend.title = element_blank(),
legend.position = "right",
legend.margin = margin(10, 30, 10, 10), # Adds spacing (top, right, bottom, left)
# **Add Axis Ticks**
axis.ticks = element_line(color = "black", size = 0.8), # Enables ticks
axis.ticks.length = unit(0.2, "cm"), # Adjusts tick size
) +
# Define Colors for Legend
# Define Colors for Legend
# Define Colors and Order for Legend
scale_color_manual(
values = c(
"Life Satisfaction" = "blue",
"Reconstructed Life Satisfaction" = "red",
"GDP per capita" = "gray50",
"Life Event Effect Index" = "black"
),
labels = c(
"Reconstructed Life Satisfaction" = "Reconstructed Life Satisfaction",
"Life Satisfaction" = "Life Satisfaction (Reported)",
"GDP per capita" = "GDP per capita",
"Life Event Effect Index" = "Life Event Effect Index"
),
limits = c(
"Reconstructed Life Satisfaction",
"Life Satisfaction",
"GDP per capita",
"Life Event Effect Index"
) # This sets the legend order
)
