---
title: "RESPONDENTS’ PREFERRED SURVEY TOPICS: MEASUREMENT AND PREVALENCE"
subtitle: "Replication Files: Study 3"
author: "Tobias Gummer, Saskia Bartholomäus, and Bernd Weiss"
date: "19.01.2026"
output:
  html_document:
    theme: united
    toc: true
    toc_depth: 4
    toc_float:
      collapsed: true
      smooth_scroll: true
---
***
```{r loading dataset, message=FALSE, warning=FALSE, include=FALSE}
# Loading Dataset
load("data/subset.RData")
```

# Principal Component Analysis
 
Identifying Number of Components
 
```{r exploratory factor analysis topic interest, message=FALSE, warning=FALSE, fig.width=10, fig.height=4, out.width='100%', out.height='auto'}
scree_plot(subset, method="pc")
```  
 
Table Principal Component Analysis
 
```{r fit pca, message=FALSE, warning=FALSE, include=FALSE}
fit_topic <- principal(subset, nfactors = 2, rotate = "varimax")
results_pca <- as.data.frame.matrix(fit_topic[["loadings"]])
results_pca <- cbind(results_pca, as.data.frame(fit_topic[["uniquenesses"]]))
results_pca <- cbind(results_pca, as.data.frame(fit_topic[["complexity"]]))
results_pca <- cbind(rownames(results_pca), data.frame(results_pca, row.names=NULL))
colnames(results_pca)<- c("Topic Interest", "Factor Loadings 1", "Factor Loadings 2", "Uniqueness", "Complexity")
results_pca[, 2:5] <- round(results_pca[, 2:5], 2)

n_row <- data.frame("Topic Interest" = "N",
  "Factor Loadings 1" = fit_topic$n.obs, "Factor Loadings 2" = NA, 
  "Uniqueness" = NA, "Complexity" = NA)
eigenvalues <- fit_topic$values[1:2]
eigenvalues_row <- data.frame("Topic Interest" = "Eigenvalues",
  "Factor Loadings 1" = round(eigenvalues[1], 2),
  "Factor Loadings 2" = round(eigenvalues[2], 2),
  "Uniqueness" = NA, "Complexity" = NA)

colnames(eigenvalues_row) <- colnames(results_pca)
colnames(n_row) <- colnames(results_pca)
table_pca <- rbind(results_pca, eigenvalues_row, n_row)
table_pca[table_pca[["Topic Interest"]] == "N", "Factor Loadings 1"] <- as.character(as.integer(table_pca[table_pca[["Topic Interest"]] == "N", "Factor Loadings 1"]))
table_pca[is.na(table_pca)] <- ""

vars <- c("tp_well", "tp_personal", "tp_nature", "tp_crisis", "tp_work", "tp_economy", "tp_pol", "tp_media", "tp_migration", "tp_leisure")
labels <- c("Well-Being", "Values", "Nature", "Crisis", "Work", "Economy", "Politics", "Media", "Migration", "Leisure")

var_labels <- setNames(labels, vars)
table_pca <- table_pca %>%
  mutate(`Topic Interest` = ifelse(`Topic Interest` %in% names(var_labels), 
  var_labels[`Topic Interest`], `Topic Interest`))
```
```{r pca-table, echo=FALSE, message=FALSE, warning=FALSE, results='asis'}
knitr::kable(table_pca)
```
 
Plot Principal Component Analysis
 
```{r pca plot, message=FALSE, warning=FALSE, fig.width=10, fig.height=4, out.width='100%', out.height='auto'}
g_pca <- ggplot(results_pca, aes(x = `Factor Loadings 1`, y = `Factor Loadings 2`)) +
  labs(x = "Factor Loadings 1", y = "Factor Loadings 2") +
  geom_point(aes(colour = `Factor Loadings 1` < 0.5 & `Factor Loadings 2` > 0.5), show.legend = FALSE) +
  geom_text(aes(label = c("nature and environment", "current crisis", "personality and values", "economy and society", "leisure and rest", "satisfaction and well-being", "flight and migration", "work and occupation", "political attiudes and behavior", "media and social networks")), 
       hjust = 0, nudge_x = 0.02, size = 3, family = "Times New Roman", colour = "black") + 
  theme_light() + custom_theme + scale_color_grey() +
  scale_y_continuous(limits = c(0, 1.)) +
  scale_x_continuous(limits = c(-0.035, 1.)) + 
  geom_hline(yintercept = 0.5) + 
  geom_vline(xintercept = 0.5) + 
  guides(colour = guide_legend(title.position = "top", title.hjust = 0.5)) 

g_pca
```
```{r save plot, message=FALSE, warning=FALSE, include=FALSE}
ggsave(plot = g_pca, filename = "graphs/g_pca.pdf", device = cairo_pdf,
  width = 18, height = 10, units = "cm")
```
```{r rm, message=FALSE, warning=FALSE, include=FALSE}
rm(fit1_topic, fit2_topic, g_pca, i_topic, results_pca, dbd_dta, labels)
```