Visualizing Predicted probabilities

Installing libraries and loading data

library(ggplot2)

Warning: package ‘ggplot2’ was built under R version 4.4.3

library(dplyr)

Warning: package ‘dplyr’ was built under R version 4.4.3

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(tidyr)

Warning: package ‘tidyr’ was built under R version 4.4.3

library(readr)

Warning: package ‘readr’ was built under R version 4.4.3

library(haven)

Warning: package ‘haven’ was built under R version 4.4.3

datapath <- "C:/Users/jerek/Documents/My Library/OPETUS/Kultut_Ope/_Tutkimus & kirjoitus/legitrel/OHJELMAT 2023/Pol-o_multinom_R/SS_Ref2/ohjelmat_SS_R2.sav"
data <- read_sav(datapath)

Visualizing Predicted Probabilities

data_long <- data %>%
  pivot_longer(cols = starts_with("EST"), 
               names_to = "category", 
               values_to = "probability")

# Get variable labels from SPSS attributes
labels <- sapply(data[ , startsWith(names(data), "EST")], function(x) attr(x, "label"))

# Add variable label column
data_long <- data_long %>%
  mutate(variable_label = labels[as.character(category)])

# Plot
ggplot(data_long, aes(x = Zgaltan_y, y = probability, color = variable_label)) +
  geom_smooth(se = FALSE, method = "loess", span = 0.8) +
  theme_minimal() +
  labs(
    x = "GAL–TAN Scale (Standardized)", 
    y = "Predicted Probability", 
    color = "Legitimation Frame",
    title = "Predicted Probabilities by GAL–TAN Position"
  )

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

Moving forward: including all varibles in the model

Recalculating new variable for plotting

data$lr_combined = (data$lrgen_y + data$lrecon_y) / 2

Definitions

library(ggplot2)
library(dplyr)
library(tidyr)
library(patchwork)

Warning: package ‘patchwork’ was built under R version 4.4.3

# OLD
#predictors <- c("Zp_age", "Zgaltan_y", "Zseat_y", "Zlr_combined", 
#                "Zp_age_x_Zgaltan_y", "Zp_age_x_Zseat_y", "Zgaltan_y_x_Zseat_y")

#var_labels <- c(
#  "Zp_age" = "Party Age (Z-score)",
#  "Zgaltan_y" = "GAL-TAN (Z-score)",
#  "Zseat_y" = "Share of Seats (Z-score)",
#  "Zlr_combined" = "Left-Right (combined, Z-sc.)",
#  "Zp_age_x_Zgaltan_y" = "Party Age x GAL-TAN (Z-sc.)",
#  "Zp_age_x_Zseat_y" = "Party Age x Share of Seats (Z-sc.)",
#  "Zgaltan_y_x_Zseat_y" = "GAL-TAN x Share of Seats (Z-sc.)"
#  )

# NEW
predictors <- c("p_age", 
                "galtan_y", 
                "seat_y", 
                "lr_combined",
                "Zp_age_x_Zseat_y",
                "Zlr_combined_x_Zp_age",
                "Zgaltan_y_x_Zseat_y",
                "Zlr_combined_x_Zgaltan_y")

var_labels <- c("p_age" = "Party Age (years)", 
                "galtan_y" = "GAL-TAN", 
                "seat_y" = "Share of Seats (%)", 
                "lr_combined" = "Left-Right (combined)",
                "Zp_age_x_Zseat_y" = "Party Age x Share of Seats (Z-sc.)",
                "Zlr_combined_x_Zp_age" = "Left-Right (comb.) x Party Age (Z-sc.)",
                "Zgaltan_y_x_Zseat_y" = "GAL-TAN x Share of Seats (Z-sc.)",
                "Zlr_combined_x_Zgaltan_y" = "Left-Right (comb.) x GAL-TAN (Z-sc.)")

Pivoting and mutating dataset

# Assuming predicted probability columns start with "EST"
data_long <- data %>%
  pivot_longer(cols = starts_with("EST"), 
               names_to = "category", 
               values_to = "probability")

# Get variable labels from SPSS attributes
labels <- sapply(data[ , startsWith(names(data), "EST")], function(x) attr(x, "label"))

# Attach human-readable category labels
data_long <- data_long %>%
  mutate(variable_label = labels[as.character(category)])

Building the plot, including interactions

# Find global y-axis range
ymin <- min(data_long$probability, na.rm = TRUE)
ymax <- max(data_long$probability, na.rm = TRUE)

# Create an empty list to store plots
plot_list <- list()

# Loop through predictors
for (pred in predictors) {
  # If interaction term, create it on the fly
  if (grepl("_x_", pred)) {
    parts <- unlist(strsplit(pred, "_x_"))
    data_long[[pred]] <- data_long[[parts[1]]] * data_long[[parts[2]]]
  }

  # Create the plot
  p <- ggplot(data_long, aes_string(x = pred, y = "probability", color = "variable_label")) +
    geom_smooth(se = FALSE, method = "loess", span = 0.8) +
    theme_minimal(base_size = 20) +
    coord_cartesian(ylim = c(ymin, ymax)) +
    labs(
      x = var_labels[pred],
      y = "Predicted Probability",
      color = "Legitimation Frame"
    )

  # Add plot to list
  plot_list[[pred]] <- p
}

Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
ℹ Please use tidy evaluation idioms with `aes()`.
ℹ See also `vignette("ggplot2-in-packages")` for more information.
This warning is displayed once every 8 hours.
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.

Displaying the plot

library(patchwork)

#heights_vector <- c(4,4,4,4,4,4,4)  # Adjust as needed



combined_plot <- wrap_plots(plot_list, ncol = 3,  guides = "collect") &
  theme(
    legend.position = "right",
    legend.box.margin = margin(t = 10, l=2, r = 2),
    legend.key.spacing = unit(0.2, "lines"),
    legend.title = element_text(size = 8),
    legend.text = element_text(size = 6),
    
    plot.margin = margin(t=27,r=1,l=5,b=5),
    plot.title = element_text(size = 10, face = "bold"),
    axis.title = element_text(size = 6),
    axis.text = element_text(size = 6)
  ) & coord_cartesian(ylim = c(0,.8))

Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.

combined_plot <- combined_plot +
  plot_annotation(title = "Predicted Probabilities by Explanatory Variable",
                  theme = theme(plot.title = element_text(hjust = 0.5)))

# Show plot
combined_plot

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

Saving plot

ggsave(combined_plot, 
       filename = "C:/Users/jerek/Documents/My Library/OPETUS/Kultut_Ope/_Tutkimus & kirjoitus/legitrel/OHJELMAT 2023/Pol-o_multinom_R/SS_Ref2/combined_plot_new2.tiff",
       device = "tiff",
       height = 6, 
       width = 8, 
       units = "in")

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

Highlighting significant covariates

library(tibble)
library(dplyr)
library(ggplot2)
library(patchwork)
library(colorspace) # for lighten()

# Manual significance mapping
sig_map <- tribble(
  ~variable_label,                      ~predictor,
  "Equality", "p_age", 
  "Equality", "galtan_y", 
  "Equality", "seat_y", 
  "Equality", "lr_combined",
  "Equality", "Zp_age_x_Zseat_y",
  "Equality", "Zlr_combined_x_Zp_age",
  "Equality", "Zgaltan_y_x_Zseat_y",
  "Equality", "Zlr_combined_x_Zgaltan_y",
  "Denying special status", "galtan_y",
  "Denying special status", "Zlr_combined_x_Zp_age",
  "Denying special status", "Zgaltan_y_x_Zseat_y",
  "Protecting special status", "galtan_y",
  "Protecting special status", "Zgaltan_y_x_Zseat_y",
  "Public utility", "galtan_y",
  "Public utility", "lr_combined",
  "Public utility", "Zgaltan_y_x_Zseat_y",
  "Public utility", "Zlr_combined_x_Zgaltan_y",
  "Threats and governance", "galtan_y",
  "Threats and governance", "seat_y",
  "Threats and governance", "Zp_age_x_Zseat_y",
  "Values and culture", "lr_combined",
  "Values and culture", "p_age_y",
  "Values and culture", "Zlr_combined_x_Zp_age"
)

# Pick a base color palette for frames
frame_colors <- RColorBrewer::brewer.pal(n = length(unique(data_long$variable_label)), "Set2")
names(frame_colors) <- unique(data_long$variable_label)

# Find y-axis range
ymin <- min(data_long$probability, na.rm = TRUE)
ymax <- max(data_long$probability, na.rm = TRUE)

plot_list <- list()

for (pred in predictors) {
  
  # Create interaction variable if needed
  if (grepl("_x_", pred)) {
    parts <- unlist(strsplit(pred, "_x_"))
    data_long[[pred]] <- data_long[[parts[1]]] * data_long[[parts[2]]]
  }
  
  df_plot <- data_long %>%
    mutate(
      significance = ifelse(
        variable_label %in% (sig_map %>% filter(predictor == pred) %>% pull(variable_label)),
        "significant", "nonsignificant"
      )
    )
  
  p <- ggplot() +
    
    # Significant lines — solid original color
    geom_smooth(
      data = subset(df_plot, significance == "significant"),
      aes_string(x = pred, y = "probability", color = "variable_label", group = "variable_label"),
      se = FALSE, method = "loess", span = 0.8, size = 1
    ) +
    
    # Non-significant lines — lighter shade of the same color + dashed
    geom_smooth(
      data = subset(df_plot, significance == "nonsignificant"),
      aes_string(x = pred, y = "probability", group = "variable_label", color = "variable_label"),
      se = FALSE, method = "loess", span = 0.8, size = 0.8, linetype = "dashed",
      show.legend = FALSE
    ) +
    
    scale_color_manual(values = frame_colors) +
    
    theme_minimal(base_size = 20) +
    coord_cartesian(ylim = c(ymin, ymax)) +
    labs(
      x = var_labels[pred],
      y = "Predicted Probability",
      color = "Legitimation Frame"
    ) +
    guides(color = guide_legend(override.aes = list(linetype = "solid", size = 1)))
  
  # Lighten the non-significant lines after plotting
  p <- p +
    scale_color_manual(
      values = setNames(
        frame_colors,
        names(frame_colors)
      ),
      guide = guide_legend(override.aes = list(linetype = "solid", size = 1))
    ) +
    theme(legend.position = "right")
  
  plot_list[[pred]] <- p
}

Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.

# Combine all predictor plots
combined_plot <- wrap_plots(plot_list, ncol = 3, guides = "collect") &
  theme(
    legend.position = "right",
    legend.box.margin = margin(t = 10, l = 2, r = 2),
    legend.key.spacing = unit(0.2, "lines"),
    legend.title = element_text(size = 8),
    legend.text = element_text(size = 6),
    plot.margin = margin(t = 27, r = 1, l = 5, b = 5),
    plot.title = element_text(size = 10, face = "bold"),
    axis.title = element_text(size = 6),
    axis.text = element_text(size = 6)
  ) & coord_cartesian(ylim = c(0, .8))

Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.
Coordinate system already present. Adding new coordinate system, which will replace the existing one.

combined_plot <- combined_plot +
  plot_annotation(title = "Predicted Probabilities by Predictor (Solid = Reference or Significant, Dashed = Not Significant)",
                  theme = theme(plot.title = element_text(hjust = 0.5)))

combined_plot

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

ggsave(combined_plot, 
       filename = "C:/Users/jerek/Documents/My Library/OPETUS/Kultut_Ope/_Tutkimus & kirjoitus/legitrel/OHJELMAT 2023/Pol-o_multinom_R/SS_Ref2/pred_prob_legend.tiff",
       device = "tiff",
       height = 6, 
       width = 8, 
       units = "in")

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