community_variable <- "pe_left_center_right"
community_order <- c("left", "center", "right")
wave_order <- c("First", "Second", "Third", "Fourth", "Fifth", "Sixth")
dimensions_order <- c("Overall", "Cognitive", "Behavioral", "Social")
wave_transition_order <-
c("First-Second", "Second-Third", "Third-Fourth", "Fourth-Fifth", "Fifth-Sixth")
# Read the data from indices_table.txt
df <- as.data.frame(readRDS("Israel Survey/data/il_pe.RDS"))
indices_df <- af_gauge_indices(df, pop_var1 = "Wave", comm_var1 = community_variable,
threshold_type = "MAD", k_factor = 1.5)
indices_data <- indices_df$indices_table
# Convert data to a more manageable format for analysis
df <- indices_data %>%
mutate(Wave = factor(Wave, levels = wave_order)) %>%
mutate(!!sym(community_variable) := factor(!!sym(community_variable), levels = community_order))
# Separate the data into population and community data
pop_data <- df %>% filter(is.na(!!sym(community_variable)))
community_data <- df %>% filter(!is.na(!!sym(community_variable)))
The extremism levels analysis across cognitive, behavioral, and social dimensions provides compelling evidence for the differential impact of destabilizing events on political extremism, strongly supporting hypotheses regarding non-uniform dimensional responses (H1), political orientation moderation effects (H2), and group-specific threat dynamics (H3). The cognitive dimension demonstrates the most pronounced volatility, with left-wing ideological extremism experiencing dramatic surges during governmental transitions—increasing from 34.29% to 60.38% following the Bennett Government fall and maintaining elevation at 57.30% during the Judicial Reform period, representing a 26.09 percentage point increase that contrasts sharply with right-wing cognitive extremism’s concurrent decline from 21.98% to 13.72% over the same timeline. These opposing trajectories provide clear evidence of political orientation’s moderating role, with left-wing and center citizens perceiving governmental instability and judicial reforms as existential threats while right-wing citizens experience reduced extremism during periods of political alignment with their preferences. The behavioral dimension reveals fundamentally different response patterns, characterized by more gradual trajectories and cross-cutting dynamics where left-wing violence extremism actually declined during periods of peak cognitive mobilization—dropping from 32.92% to 17.92% during the Bennett fall while cognitive extremism surged. Right-wing behavioral extremism followed a consistent decline pattern from 39.62% to 27.79%, suggesting that political events may moderate rather than amplify violence-oriented extremism among baseline-predisposed groups. The social dimension exhibits the most stratified baseline differences, with right-wing citizens maintaining consistently elevated intolerance levels (21-26%) compared to center (6-11%) and left-wing citizens (0-5%), demonstrating fundamental ideological predispositions that transcend event-specific responses. The October 7th War provides universal support for threat-induced extremism, generating increases across all dimensions and orientations while preserving orientation-based hierarchies.
The ER3 analysis, measuring citizens exceeding extremism thresholds across all three dimensions simultaneously, reinforces the extremism levels findings while revealing the exceptional rarity of comprehensive radicalization. Right-wing citizens demonstrate consistently higher rates of multi-dimensional extremism (3.77-4.17% range) that paradoxically decline during periods of political alignment, dropping from 4.17% post-Inland Terror to 1.57% before October 7th—a 2.60 percentage point decrease coinciding with reduced single-dimension extremism levels during the Judicial Reform and Gallant periods. Left-wing comprehensive extremism shows remarkable volatility with extended absence periods (0.00% during Bennett fall, Judicial Reform, and Gallant dismissal), before resurging to 0.81% post-October 7th, mirroring the single-dimension patterns of temporary deactivation followed by crisis-induced mobilization. The universal emergence of comprehensive extremism following October 7th (right: 1.06%, center: 0.61%, left: 0.81%) validates the threat-based extremism hypothesis while confirming that multi-dimensional radicalization represents an intensified manifestation of the same political orientation dynamics observed in single-dimension extremism levels.
The extremism intensity analysis reveals that while political events dramatically influence the proportion of citizens embracing extremist positions (extensive margin), they have minimal impact on the severity of beliefs among already radicalized individuals (intensive margin), providing crucial insights that complement the extremism levels findings. Across all dimensions, intensity variations remain remarkably compressed—cognitive intensity ranges of only 0.47-0.78 points despite 26-percentage-point level fluctuations, and social intensity variations of merely 0.18-0.38 points—indicating that extremism operates primarily through recruitment and demobilization mechanisms rather than progressive belief intensification. The notable exception occurs in left-wing behavioral intensity, which increases 0.56 points following October 7th (from 2.44 to 3.00), suggesting that while most extremism dimensions function through binary activation processes, external security threats may uniquely deepen violence-oriented inclinations among progressive extremists. These patterns demonstrate that the dramatic extremism level changes identified earlier reflect shifts in extremist constituency size rather than radicalization depth, indicating that political events mobilize latent attitudes rather than progressively radicalizing moderate positions, with important implications for understanding how crises expand rather than intensify extremist movements.
plot_data <- community_data
# p1 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "oel_c",
# grouping_variable = community_variable, show_points = TRUE,
# title = "Overall - Extremism Levels",
# y_label = "oel_c %",
# legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
# af_event_labels(p1)
# af_create_xy_table(df = plot_data, x_var = "Wave", y_var = "oel_c", g_var = community_variable)
p2 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "cel_c",
grouping_variable = community_variable, show_points = TRUE,
title = "Cognitive Dimension - Extremism Levels",
y_label = "cel_c %",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p2)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 34.16 | 34.29 | 60.38 | 57.30 | 33.71 | 48.39 |
center | 12.93 | 9.89 | 12.18 | 21.69 | 15.97 | 24.39 |
right | 21.98 | 17.70 | 16.61 | 16.71 | 13.72 | 16.16 |
p3 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "bel_c",
grouping_variable = community_variable, show_points = TRUE,
title = "Behavioral Dimension - Extremism Levels",
y_label = "bel_c %",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p3)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 32.92 | 20.00 | 17.92 | 29.21 | 33.15 | 39.52 |
center | 30.39 | 24.00 | 28.99 | 31.22 | 30.63 | 38.72 |
right | 39.62 | 38.56 | 35.79 | 27.68 | 30.15 | 27.79 |
p4 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "sel_c",
grouping_variable = community_variable, show_points = TRUE,
title = "Social Dimension - Extremism Levels",
y_label = "sel_c %",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p4)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 2.88 | 3.67 | 2.83 | 0.00 | 2.81 | 4.84 |
center | 10.56 | 6.53 | 7.56 | 8.99 | 8.32 | 8.54 |
right | 22.64 | 26.27 | 20.30 | 22.43 | 21.15 | 21.15 |
plot_data <- community_data
# p1 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "oin_c",
# grouping_variable = community_variable, show_points = TRUE,
# title = "Overall - Extremism Intensity",
# y_label = "oin_c",
# legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
# af_event_labels(p1)
# af_create_xy_table(df = plot_data, x_var = "Wave", y_var = "oin_c", g_var = community_variable)
p2 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "cin_c",
grouping_variable = community_variable, show_points = TRUE,
title = "Cognitive Dimension - Extremism Intensity",
y_label = "cin_c",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p2)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 6.81 | 6.41 | 6.34 | 6.36 | 6.54 | 6.69 |
center | 6.70 | 6.32 | 6.10 | 6.09 | 6.44 | 6.50 |
right | 6.91 | 6.31 | 6.13 | 6.25 | 6.73 | 6.45 |
p3 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "bin_c",
grouping_variable = community_variable, show_points = TRUE,
title = "Behavioral Dimension - Extremism Intensity",
y_label = "bin_c",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p3)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 2.09 | 2.39 | 2.21 | 2.37 | 2.44 | 3.00 |
center | 2.52 | 2.77 | 2.54 | 2.68 | 2.68 | 2.55 |
right | 2.39 | 2.75 | 2.67 | 2.64 | 2.73 | 2.67 |
p4 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "sin_c",
grouping_variable = community_variable, show_points = TRUE,
title = "Social Dimension - Extremism Intensity",
y_label = "sin_c",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p4)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 6.19 | 6.22 | 6.57 | NaN | 6.30 | 6.38 |
center | 6.20 | 6.08 | 6.46 | 6.29 | 6.37 | 6.33 |
right | 6.31 | 6.28 | 6.44 | 6.30 | 6.42 | 6.26 |
p1 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "er1_c",
grouping_variable = community_variable, show_points = TRUE,
title = "ER1",
y_label = "er1_c %",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p1)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 56.79 | 51.43 | 74.53 | 73.03 | 55.06 | 79.84 |
center | 46.55 | 37.26 | 45.80 | 51.85 | 46.83 | 59.45 |
right | 62.04 | 57.84 | 54.43 | 50.36 | 52.31 | 51.06 |
p2 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "er2_c",
grouping_variable = community_variable, show_points = TRUE,
title = "ER2",
y_label = "er2_c %",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p2)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 12.76 | 6.12 | 6.60 | 13.48 | 14.61 | 12.10 |
center | 6.90 | 2.95 | 2.94 | 9.52 | 8.10 | 11.59 |
right | 18.42 | 20.52 | 15.13 | 13.60 | 11.14 | 12.99 |
p3 <- af_create_xy_plot(data = plot_data, x_var = "Wave", y_var = "er3_c",
grouping_variable = community_variable, show_points = TRUE,
title = "ER3",
y_label = "er3_c %",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p3)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 0.41 | 0.41 | 0.00 | 0.00 | 0.00 | 0.81 |
center | 0.43 | 0.21 | 0.00 | 0.53 | 0.00 | 0.61 |
right | 3.77 | 4.17 | 3.14 | 2.86 | 1.57 | 1.06 |
The ratio of Community to Population Extremism Levels indicates the community impact on the population extremism level. Ratio > 1 indicate communities contributing disproportionately to population extremism, The higher the ratio the more disproportionate thier contribution is.
# Calculate ratios for extremism levels
# ratio_data <- af_calculate_ratio(df, community_variable, "oel_c", "oel_p")
# p1 <- af_create_xy_plot(data = ratio_data, x_var = "Wave", y_var = "ratio",
# grouping_variable = community_variable, show_points = TRUE,
# title = "Overall - Impact Ratio",
# y_label = "oel_c / oel_p Ratio",
# legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
# af_event_labels(p1)
# af_create_xy_table(df = ratio_data, x_var = "Wave", y_var = "ratio", g_var = community_variable)
ratio_data <- af_calculate_ratio(df, community_variable, "cel_c", "cel_p")
p2 <- af_create_xy_plot(data = ratio_data, x_var = "Wave", y_var = "ratio",
grouping_variable = community_variable, show_points = TRUE,
title = "Cognitive Dimension - Impact Ratio",
y_label = "cel_c / cel_p Ratio",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p2)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 1.61 | 1.91 | 2.92 | 2.47 | 2.01 | 2.18 |
center | 0.61 | 0.55 | 0.59 | 0.93 | 0.95 | 1.10 |
right | 1.04 | 0.99 | 0.80 | 0.72 | 0.82 | 0.73 |
ratio_data <- af_calculate_ratio(df, community_variable, "bel_c", "bel_p")
p3 <- af_create_xy_plot(data = ratio_data, x_var = "Wave", y_var = "ratio",
grouping_variable = community_variable, show_points = TRUE,
title = "Behavioral Dimension - Impact Ratio",
y_label = "bel_c / bel_p Ratio",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p3)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 0.92 | 0.64 | 0.56 | 1.01 | 1.08 | 1.22 |
center | 0.85 | 0.76 | 0.91 | 1.08 | 1.00 | 1.20 |
right | 1.10 | 1.23 | 1.12 | 0.96 | 0.98 | 0.86 |
ratio_data <- af_calculate_ratio(df, community_variable, "sel_c", "sel_p")
p4 <- af_create_xy_plot(data = ratio_data, x_var = "Wave", y_var = "ratio",
grouping_variable = community_variable, show_points = TRUE,
title = "Social Dimension - Impact Ratio",
y_label = "sel_c / sel_p Ratio",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p4)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 0.18 | 0.22 | 0.19 | 0.00 | 0.19 | 0.31 |
center | 0.65 | 0.38 | 0.51 | 0.56 | 0.55 | 0.55 |
right | 1.40 | 1.55 | 1.37 | 1.41 | 1.40 | 1.35 |
The concentration measure captures the relative prominence of the most extreme group—those scoring at the extreme end on all three dimensions—within the broader population of extremists, defined as individuals who are extreme on at least one dimension, in each community.
Analysis of the concentration of extremism (measured by er3_c/er1_c ratio) reveals that Orthodox communities consistently show higher concentrations of multi-dimensional extremism compared to other communities.
# Calculate concentration ratios for multi-dimensional extremism
multi_dim_data <- af_calculate_concentration(df, community_variable, "er3_c", "er1_c")
# Remove rows with NA or infinite values
multi_dim_data <- multi_dim_data %>%
filter(is.finite(concentration_ratio))
p <- af_create_xy_plot(data = multi_dim_data, x_var = "Wave", y_var = "concentration_ratio",
grouping_variable = community_variable, show_points = TRUE,
title = "Concentration of Multi-dimensional Extremism by Community",
subtitle = "Higher values indicate Higher concentration",
y_label = "er3_c / er1_c Ratio",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p)
af_create_xy_table(df = multi_dim_data, x_var = "Wave", y_var = "concentration_ratio", g_var = community_variable)
pe_left_center_right | First | Second | Third | Fourth | Fifth | Sixth |
---|---|---|---|---|---|---|
left | 0.01 | 0.01 | 0.00 | 0.00 | 0.00 | 0.01 |
center | 0.01 | 0.01 | 0.00 | 0.01 | 0.00 | 0.01 |
right | 0.06 | 0.07 | 0.06 | 0.06 | 0.03 | 0.02 |
This analysis examines how each community disproportionately contributes to extremism in the Israeli Jewish population across six survey waves. We compare each community’s extremism levels (measured against population thresholds) with their relative proportion in the population, to identify which communities have higher or lower impact than their size would suggest.
We calculate an “impact ratio” for each community, dimension, and wave using the formula:
Impact Ratio = Extremism Level (EL_c) / (Population Proportion × 100)
Where: - Extremism Level (EL_c) is the percentage of community members exceeding the population’s extremism threshold - Population Proportion is the community’s size (nc) divided by the total population (np)
An impact ratio of 1.0 means the community’s contribution to extremism is proportional to its size. Values greater than 1.0 indicate disproportionate impact, while values less than 1.0 suggest lower impact than expected based on size.
# Extract community data
community_data <- indices_data %>%
filter(!is.na(!!sym(community_variable))) %>%
select(Wave, !!sym(community_variable), nc, np,
cel_c, bel_c, sel_c, oel_c)
# Calculate population proportion for each community
community_data <- community_data %>%
mutate(pop_proportion = nc / np)
# Calculate disproportionality indices for each dimension
# Values > 1 indicate disproportionate impact on extremism relative to size
community_data <- community_data %>%
mutate(
cognitive_impact_ratio = cel_c / (pop_proportion * 100),
behavioral_impact_ratio = bel_c / (pop_proportion * 100),
social_impact_ratio = sel_c / (pop_proportion * 100),
overall_impact_ratio = oel_c / (pop_proportion * 100)
)
# Reorganize for plotting
impact_data_long <- community_data %>%
select(Wave, !!sym(community_variable), pop_proportion,
cognitive_impact_ratio, behavioral_impact_ratio,
social_impact_ratio, overall_impact_ratio) %>%
pivot_longer(
cols = c(cognitive_impact_ratio, behavioral_impact_ratio,
social_impact_ratio, overall_impact_ratio),
names_to = "dimension",
values_to = "impact_ratio"
) %>%
mutate(
dimension = case_when(
dimension == "cognitive_impact_ratio" ~ "Cognitive",
dimension == "behavioral_impact_ratio" ~ "Behavioral",
dimension == "social_impact_ratio" ~ "Social",
dimension == "overall_impact_ratio" ~ "Overall"
)
)
# Create a standard order for communities
community_data[[community_variable]] <- factor(community_data[[community_variable]], levels = community_order)
impact_data_long[[community_variable]] <- factor(impact_data_long[[community_variable]], levels = community_order)
# # Filter for Overall dimension
# overall_impact <- impact_data_long %>% filter(dimension == "Overall")
# p1 <- af_create_xy_plot(data = overall_impact, x_var = "Wave", y_var = "impact_ratio",
# grouping_variable = community_variable, show_points = TRUE,
# title = "Overall Extremism Level - Community Impact Ratio",
# y_label = "Impact Ratio (EL_c / Population Proportion)",
# legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
# af_event_labels(p1)
# af_create_xy_table(df = overall_impact, x_var = "Wave", y_var = "impact_ratio", g_var = community_variable)
# Filter for Cognitive dimension
cognitive_impact <- impact_data_long %>% filter(dimension == "Cognitive")
p2 <- af_create_xy_plot(data = cognitive_impact, x_var = "Wave", y_var = "impact_ratio",
grouping_variable = community_variable, show_points = TRUE,
title = "Cognitive Extremism Level - Community Impact Ratio",
y_label = "Impact Ratio (EL_c / Population Proportion)",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p2)
af_create_xy_table(df = cognitive_impact, x_var = "Wave", y_var = "impact_ratio", g_var = community_variable)
pe_left_center_right | First | Second | Third | Fifth | Sixth | Fourth |
---|---|---|---|---|---|---|
left | 2.26 | 2.25 | 5.05 | 2.89 | 4.35 | 4.49 |
center | 0.45 | 0.33 | 0.45 | 0.53 | 0.83 | 0.80 |
right | 0.39 | 0.32 | 0.27 | 0.24 | 0.27 | 0.28 |
# Filter for Behavioral dimension
behavioral_impact <- impact_data_long %>% filter(dimension == "Behavioral")
p3 <- af_create_xy_plot(data = behavioral_impact, x_var = "Wave", y_var = "impact_ratio",
grouping_variable = community_variable, show_points = TRUE,
title = "Behavioral Extremism Level - Community Impact Ratio",
y_label = "Impact Ratio (EL_c / Population Proportion)",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p3)
af_create_xy_table(df = behavioral_impact, x_var = "Wave", y_var = "impact_ratio", g_var = community_variable)
pe_left_center_right | First | Second | Third | Fifth | Sixth | Fourth |
---|---|---|---|---|---|---|
left | 2.18 | 1.31 | 1.50 | 2.84 | 3.55 | 2.29 |
center | 1.05 | 0.81 | 1.08 | 1.02 | 1.32 | 1.15 |
right | 0.71 | 0.70 | 0.59 | 0.52 | 0.47 | 0.46 |
# Filter for Social dimension
social_impact <- impact_data_long %>% filter(dimension == "Social")
p4 <- af_create_xy_plot(data = social_impact, x_var = "Wave", y_var = "impact_ratio",
grouping_variable = community_variable, show_points = TRUE,
title = "Social Extremism Level - Community Impact Ratio",
y_label = "Impact Ratio (EL_c / Population Proportion)",
legend_position = "bottom") + scale_x_discrete(limits = levels(df$Wave))
af_event_labels(p4)
af_create_xy_table(df = social_impact, x_var = "Wave", y_var = "impact_ratio", g_var = community_variable)
pe_left_center_right | First | Second | Third | Fifth | Sixth | Fourth |
---|---|---|---|---|---|---|
left | 0.19 | 0.24 | 0.24 | 0.24 | 0.43 | 0.00 |
center | 0.37 | 0.22 | 0.28 | 0.28 | 0.29 | 0.33 |
right | 0.40 | 0.48 | 0.33 | 0.36 | 0.36 | 0.37 |
# Calculate average impact ratios across waves for each community and dimension
impact_summary <- impact_data_long %>%
group_by(!!sym(community_variable), dimension) %>%
summarize(
mean_impact = mean(impact_ratio, na.rm = TRUE),
min_impact = min(impact_ratio, na.rm = TRUE),
max_impact = max(impact_ratio, na.rm = TRUE),
consistency = max_impact - min_impact # Lower values indicate more consistent impact
) %>%
ungroup()
# Reshape for visualization
impact_summary_wide <- impact_summary %>%
select(!!sym(community_variable), dimension, mean_impact) %>%
pivot_wider(names_from = dimension, values_from = mean_impact)
af_create_heatmap(data = impact_summary, x_var = "dimension", y_var = community_variable,
fill_var = "mean_impact",
title = "Average Extremism Level Impact Ratio by Community and Dimension",
subtitle = "Higher values indicate more disproportionate impact relative to size",
x_label = "Dimension of Extremism",
y_label = "Political Orientation Group",
fill_label = "Impact Ratio",
legend_position = "bottom")
impact_summary_wide %>%
gt() %>%
tab_header(title = md("**Average Impact Ratio by Community and Dimension (Across All Waves)**")) %>%
fmt_number(decimals = 2) %>%
cols_align(align = "center", columns = everything()) %>%
cols_align(align = "left", columns = 1)
Average Impact Ratio by Community and Dimension (Across All Waves) | ||||
pe_left_center_right | Behavioral | Cognitive | Overall | Social |
---|---|---|---|---|
left | 2.28 | 3.55 | 0.73 | 0.22 |
center | 1.07 | 0.57 | 0.25 | 0.29 |
right | 0.57 | 0.29 | 0.32 | 0.38 |
The Relative Extremism Change Index (RECI) is a quantitative measure that captures the relationship between community extremism level changes and population normative point changes across different time periods. It provides a single numerical indicator that helps determine whether a community’s internal extremist composition is growing or shrinking relative to broader population shifts.
The Relative Extremism Change Index (RECI) is used to examine how extremism is evolving within different communities relative to population norms. The RECI provides a valuable metric for identifying which communities are becoming more or less extreme over time, controlling for broader societal shifts.
RECI Calculation:
RECI = EL_percent_change - NP_percent_change
Where:
Interpretation:
Standardized RECI (RECI-S) normalizes the index to facilitate comparison across dimensions and waves:
RECI-S = RECI / (|EL_percent_change| + |NP_percent_change| + 1)
This bounds the index between approximately -1 and 1:
Why RECI is Valuable:
Isolates True Radicalization: RECI distinguishes between changes in extremism due to broader societal shifts versus community-specific radicalization. This helps identify which communities are becoming more extreme relative to the broader population.
Comparable Across Time Periods: The standardized RECI-S allows for direct comparison across different time periods and dimensions, enabling identification of trends and patterns.
Early Warning System: RECI can serve as an early warning indicator, highlighting communities that are experiencing increasing extremism before it becomes widely apparent in absolute measures.
Multi-Dimensional Perspective: By calculating RECI across cognitive, behavioral, social, and overall dimensions, we gain insights into which aspects of extremism are changing most rapidly.
# Calculate RECI for communities
community_transitions <- data.frame()
# Process each consecutive wave pair
for (i in 1:(length(wave_order)-1)) {
current_wave <- wave_order[i+1]
previous_wave <- wave_order[i]
# Check if both waves exist in the data
if (!(previous_wave %in% df$Wave) || !(current_wave %in% df$Wave)) {
next
}
# Filter data for current and previous waves
current_data <- df[df$Wave == current_wave, ]
previous_data <- df[df$Wave == previous_wave, ]
# Calculate RECI for this wave transition
transition_results <- af_calculate_community_reci(
current_data, previous_data, community_variable,
dimensions = c("c", "b", "s", "o")
)
# Add wave transition information
transition_results$wave_transition <- paste(previous_wave, current_wave, sep = "-")
# Append to results
community_transitions <- rbind(community_transitions, transition_results)
}
# Calculate population RECI
population_transitions <- af_prepare_population_reci_data(df, community_variable = community_variable)
event_labels <-
c("Inland Terror", "Bennet Gov. Fall", "Judicial Reform", "Galant Dismissal", "October 7")
# Create trend plot for population-level RECI
reci_data <- population_transitions %>%
mutate(dimension = factor(dimension,
levels = tolower(dimensions_order),
labels = dimensions_order)) %>%
mutate(wave_transition = factor(wave_transition,
levels = wave_transition_order,
labels = event_labels))
af_create_xy_plot(data = reci_data, x_var = "wave_transition", y_var = "reci",
grouping_variable = "dimension",
title = "Population RECI Trends",
x_label = "Wave Transition", y_label = "RECI Index",
legend_position = "bottom")
# Create heatmap for population RECI
af_create_heatmap (data = reci_data,
x_var = "wave_transition", y_var = "dimension", fill_var = "reci",
title = "Population RECI Heatmap",
x_label = "Wave Transition", y_label = "Dimension",
fill_label = "RECI Index", legend_position = "bottom")
# Create RECI table for the population
# Format the table with RECI and RECI-S values
population_table <- reci_data %>%
mutate(reci_formatted = sprintf("%.2f (%.2f)", reci, reci_s)) %>%
select(dimension, wave_transition, reci_formatted) %>%
pivot_wider(names_from = wave_transition, values_from = reci_formatted)
population_table %>%
arrange(dimension) %>%
gt() %>%
tab_header(title = md("**RECI Values for Overall Population: RECI (RECI-S)**")) %>%
cols_align(align = "center", columns = everything()) %>%
cols_align(align = "left", columns = 1)
RECI Values for Overall Population: RECI (RECI-S) | |||||
dimension | Inland Terror | Bennet Gov. Fall | Judicial Reform | Galant Dismissal | October 7 |
---|---|---|---|---|---|
Overall | 7.52 (0.88) | -11.10 (-0.92) | -2.38 (-0.70) | 3.34 (0.53) | -16.74 (-0.94) |
Cognitive | -9.55 (-0.43) | 18.93 (0.95) | 15.27 (0.94) | -36.94 (-0.97) | 33.17 (0.97) |
Behavioral | -16.30 (-0.94) | 2.89 (0.74) | -9.64 (-0.91) | 3.86 (0.40) | 4.11 (0.53) |
Social | 5.83 (0.85) | -15.53 (-0.94) | 8.26 (0.89) | -5.83 (-0.85) | 3.75 (0.79) |
communities <- community_order
# Initialize empty lists to store plots for each community
trend_plots <- list()
heatmap_plots <- list()
community_tables <- list()
# Loop through each community and create visualizations
for (comm in communities) {
# Filter data for this community
comm_data <- community_transitions %>%
filter(community == comm) %>%
mutate(dimension = factor(dimension,
levels = tolower(dimensions_order),
labels = dimensions_order)) %>%
mutate(wave_transition = factor(wave_transition,
levels = wave_transition_order,
labels = event_labels))
# Create trend plot
trend_plot <- af_create_xy_plot(comm_data, x_var = "wave_transition", y_var = "reci",
grouping_variable = "dimension",
title = paste("RECI Trends -", comm),
x_label = "Wave Transition", y_label = "RECI Index",
legend_position = "bottom") +
scale_x_discrete(labels = event_labels)
# Create heatmap
heatmap_plot <- af_create_heatmap (data = comm_data,
x_var = "wave_transition", y_var = "dimension", fill_var = "reci",
title = paste("RECI Heatmap -", comm),
x_label = "Wave Transition", y_label = "Dimension",
fill_label = "RECI Index", legend_position = "bottom")
# Create table
comm_table <- comm_data %>%
arrange(dimension) %>%
mutate(reci_formatted = sprintf("%.2f (%.2f)", reci, reci_s)) %>%
select(dimension, wave_transition, reci_formatted) %>%
pivot_wider(names_from = wave_transition, values_from = reci_formatted)
gt_table <- comm_table %>%
gt() %>%
tab_header(title = md(paste0("**RECI Values for ", comm, " Community: RECI (RECI-S)**"))) %>%
cols_align(align = "center", columns = everything()) %>%
cols_align(align = "left", columns = 1)
# Then in your loop, simply print it:
print(trend_plot)
print(heatmap_plot)
print(gt_table)
# Store plots and tables for later reference
trend_plots[[comm]] <- trend_plot
heatmap_plots[[comm]] <- heatmap_plot
community_tables[[comm]] <- comm_table
}
RECI Values for left Community: RECI (RECI-S) | |||||
dimension | Inland Terror | Bennet Gov. Fall | Judicial Reform | Galant Dismissal | October 7 |
---|---|---|---|---|---|
Overall | -31.87 (-0.86) | 48.23 (0.97) | 58.01 (0.96) | -51.00 (-0.98) | 77.74 (0.95) |
Cognitive | 6.32 (0.86) | 79.78 (0.99) | -2.35 (-0.27) | -50.11 (-0.98) | 44.20 (0.98) |
Behavioral | -42.98 (-0.98) | -8.77 (-0.68) | 62.74 (0.98) | 11.07 (0.66) | 17.86 (0.83) |
Social | 28.29 (0.97) | -25.52 (-0.96) | -99.45 (-0.98) | NA (NA) | 72.96 (0.99) |
RECI Values for center Community: RECI (RECI-S) | |||||
dimension | Inland Terror | Bennet Gov. Fall | Judicial Reform | Galant Dismissal | October 7 |
---|---|---|---|---|---|
Overall | -22.85 (-0.82) | 99.23 (0.98) | -6.35 (-0.86) | 12.05 (0.80) | -13.34 (-0.93) |
Cognitive | -17.54 (-0.58) | 26.83 (0.96) | 80.77 (0.99) | -35.30 (-0.97) | 53.34 (0.98) |
Behavioral | -24.75 (-0.96) | 22.40 (0.96) | 7.43 (0.83) | -4.26 (-0.81) | 25.04 (0.87) |
Social | -37.43 (-0.94) | 13.32 (0.69) | 19.48 (0.95) | -8.57 (-0.90) | 3.37 (0.77) |
RECI Values for right Community: RECI (RECI-S) | |||||
dimension | Inland Terror | Bennet Gov. Fall | Judicial Reform | Galant Dismissal | October 7 |
---|---|---|---|---|---|
Overall | 17.35 (0.95) | -29.03 (-0.97) | -6.84 (-0.87) | 12.39 (0.81) | -24.84 (-0.96) |
Cognitive | -13.52 (-0.51) | -2.50 (-0.23) | 3.35 (0.77) | -26.79 (-0.96) | 18.43 (0.95) |
Behavioral | -6.42 (-0.87) | -5.56 (-0.57) | -22.89 (-0.96) | 6.50 (0.53) | -9.16 (-0.90) |
Social | 16.79 (0.94) | -25.30 (-0.96) | 11.09 (0.92) | -6.75 (-0.87) | 0.71 (0.41) |
# Prepare data for community comparison
comparison_data <- community_transitions %>%
filter(community != "NA") %>%
group_by(community, dimension) %>%
summarize(
mean_reci = mean(reci, na.rm = TRUE),
max_reci = max(reci, na.rm = TRUE),
min_reci = min(reci, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(dimension = factor(dimension,
levels = tolower(dimensions_order),
labels = dimensions_order)) %>%
mutate(community = factor(community, levels = community_order))
af_create_xy_bar (data = comparison_data, x_var = "community", y_var = "mean_reci",
fill_var = "dimension", flip_axes = TRUE,
title = "Average RECI by Community and Dimension",
x_label = "Community", y_label = "Mean RECI",
legend_position = "bottom") +
geom_hline(yintercept = 0, linetype = "dashed", color = "black")