inst/doc/ResIN-VIGNETTE.R

In ResIN: Conduct Response Item Network (ResIN) Analysis with Social Response Data

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----silent intro, echo=FALSE, warning=FALSE, message=FALSE, fig.width = 7.2, fig.height = 4----
## Loading the required packages
library(ResIN)
library(dplyr, warn.conflicts = FALSE)

## Loading the data
BrJSocPsychol_2024 <- ResIN::BrJSocPsychol_2024

## Sub-setting and re-coding items in a liberal-conservative direction
Core_Items <- BrJSocPsychol_2024 %>% dplyr::select(Q9_1, Q9_2, Q9_3, Q9_4, 
                                                   Q9_5, Q9_6, Q9_7, Q9_8) %>% 
   dplyr::mutate(Q9_1 = recode(Q9_1, "Strongly Disagree" = "Strongly Agree",
                                     "Somewhat Disagree" = "Somewhat Agree",
                                     "Neutral" = "Neutral",
                                     "Somewhat Agree" = "Somewhat Disagree",
                                     "Strongly Agree" = "Strongly Disagree"),
                Q9_3 = recode(Q9_3,  "Strongly Disagree" = "Strongly Agree",
                                     "Somewhat Disagree" = "Somewhat Agree",
                                     "Neutral" = "Neutral",
                                     "Somewhat Agree" = "Somewhat Disagree",
                                     "Strongly Agree" = "Strongly Disagree"))

## Relabeling the attitudes
colnames(Core_Items) <- c("legal_abort", "equalize_incomes", "keep_immigrants", 
                          "welfare_spending", "gay_marriage", "protect_environ", 
                          "gun_control", "aid_blacks")

# Assigning response symbols for easier interpretation
Core_Items <- Core_Items %>%
  mutate(across(everything(), ~ recode(.,
    "Strongly Agree" = "++",
    "Somewhat Agree" = "+",
    "Neutral" = "+/-",
    "Somewhat Disagree" = "-",
    "Strongly Disagree" = "--",
  )))

Core_Items$dem_bias  <- as.numeric(BrJSocPsychol_2024$Q15_1) - as.numeric(BrJSocPsychol_2024$Q15_2)

## Separately specifying attitude nodes and covariate here:

ResIN_out <- ResIN(Core_Items,
                   node_vars = c("legal_abort", "equalize_incomes", "keep_immigrants",
                                 "welfare_spending", "gay_marriage", "protect_environ",
                                 "gun_control", "aid_blacks"), node_covars = c("dem_bias"),
                   node_costats = c("mean"), plot_whichstat = "dem_bias_mean",
                   plot_responselabels = FALSE, left_anchor = "legal_abort_++",
                   plot_title = "", plot_ggplot = FALSE,
                   color_palette = "RdBu", seed = 22)

ResIN_out$ResIN_ggplot + ggplot2::theme(legend.position = "none", plot.title = ggplot2::element_blank())


## ----recoding items, warning=FALSE, message = FALSE---------------------------
## Loading and installing the required packages
if(!require("ResIN")) install.packages('ResIN')
library(ResIN)
if(!require("dplyr")) install.packages('dplyr')
library(dplyr, warn.conflicts = FALSE)

## Loading the data
BrJSocPsychol_2024 <- ResIN::BrJSocPsychol_2024

## Sub-setting and re-coding items in a liberal-conservative direction
Core_Items <- BrJSocPsychol_2024 %>% dplyr::select(Q9_1, Q9_2, Q9_3, Q9_4, 
                                                   Q9_5, Q9_6, Q9_7, Q9_8) %>% 
   dplyr::mutate(Q9_1 = dplyr::recode(Q9_1, "Strongly Disagree" = "Strongly Agree",
                                     "Somewhat Disagree" = "Somewhat Agree",
                                     "Neutral" = "Neutral",
                                     "Somewhat Agree" = "Somewhat Disagree",
                                     "Strongly Agree" = "Strongly Disagree"),
                Q9_3 = dplyr::recode(Q9_3,  "Strongly Disagree" = "Strongly Agree",
                                     "Somewhat Disagree" = "Somewhat Agree",
                                     "Neutral" = "Neutral",
                                     "Somewhat Agree" = "Somewhat Disagree",
                                     "Strongly Agree" = "Strongly Disagree"))

## Relabeling the attitudes
colnames(Core_Items) <- c("legal_abort", "equalize_incomes", "keep_immigrants", 
                          "welfare_spending", "gay_marriage", "protect_environ", 
                          "gun_control", "aid_blacks")

# Assigning response symbols for easier interpretation
Core_Items <- Core_Items %>%
  mutate(across(everything(), ~ dplyr::recode(.,
    "Strongly Agree" = "++",
    "Somewhat Agree" = "+",
    "Neutral" = "+/-",
    "Somewhat Disagree" = "-",
    "Strongly Disagree" = "--",
  )))

## Setting the seed for consistency
set.seed(22)


## ----head data, echo=TRUE-----------------------------------------------------
head(Core_Items)


## ----first ResIN, fig.width = 7.2, fig.height = 4-----------------------------
ResIN_out <- ResIN(Core_Items)

## ----first ResIN with geom_ploint, fig.width = 7.2, fig.height = 4------------
ResIN_out <- ResIN(Core_Items, plot_ggplot=FALSE,
                  left_anchor = "legal_abort_++", seed = 22)

ResIN_out$ResIN_ggplot

## ----fig.width = 7.2, fig.height = 4------------------------------------------
ResIN_out <- ResIN(Core_Items, left_anchor = "legal_abort_++",
                   plot_responselabels=FALSE, seed = 22)


## ----figure 2a, fig.width = 7.2, fig.height = 4-------------------------------
ResIN_out <- ResIN(Core_Items, plot_whichstat = "choices", 
                   response_levels = c("--", "-", "+/-" , "+", "++"), 
                   plot_responselabels = FALSE, 
                   plot_title = "BrJSocPsychol 2024 ResIN Network",
                   left_anchor = "legal_abort_++", seed = 22)


## ----fig.width = 7.2, fig.height = 4------------------------------------------
## Using leading eigenvalue by default:
ResIN_out <- ResIN(Core_Items, detect_clusters = TRUE, plot_whichstat = "cluster", 
                   plot_responselabels = FALSE, plot_title = "Leading eigenvalue community detection",
                   color_palette = "Set2", seed = 22, left_anchor = "legal_abort_++")

## Switching to edge-betweenness cluster detection:
ResIN_out <- ResIN(Core_Items, detect_clusters = TRUE, plot_whichstat = "cluster",
                   cluster_method = "cluster_fast_greedy", plot_responselabels = FALSE,
                   plot_title = "Fast and greedy community detection",
                   color_palette = "Set1", seed = 22, left_anchor = "legal_abort_++")


## -----------------------------------------------------------------------------
head(ResIN_out$aux_objects$cluster_probabilities)

## ----fig.width = 7.2, fig.height = 4------------------------------------------
ResIN_out <- ResIN(Core_Items, plot_whichstat = "Betweenness", plot_responselabels = TRUE, 
                   plot_title = "ResIN node betweenness centrality", seed = 22, color_palette = "Greens",
                   left_anchor = "legal_abort_++")


## ----warning=FALSE, fig.width = 7.2, fig.height = 4---------------------------
ResIN_out <- ResIN(Core_Items, detect_clusters = TRUE, plot_whichstat = "cluster",
                   cluster_method = "cluster_edge_betweenness", 
                   plot_edgestat = "edgebetweenness",
                   plot_responselabels = FALSE, 
                   plot_title = "Edge weight based on edge-betweenness centrality",
                   seed = 22, color_palette = "Set1", left_anchor = "legal_abort_++")


## ----warning=FALSE, fig.width = 7.2, fig.height = 4---------------------------
## Calculating the relative preference of Democrats over Republicans 
  ##(Democrat feelings thermometer minus republican feelings thermometer)
Core_Items$dem_bias  <- as.numeric(BrJSocPsychol_2024$Q15_2) - 
  as.numeric(BrJSocPsychol_2024$Q15_1)

## Separately specifying attitude nodes and covariate here:

ResIN_out <- ResIN(Core_Items,
                   node_vars = c("legal_abort", "equalize_incomes", "keep_immigrants",
                                 "welfare_spending", "gay_marriage", "protect_environ",
                                 "gun_control", "aid_blacks"), node_covars = c("dem_bias"),
                   node_costats = c("mean"), plot_whichstat = "dem_bias_mean",
                   plot_responselabels = FALSE, left_anchor = "legal_abort_++",
                   plot_title = "Affective preference of Democrats over Republicans", 
                   color_palette = "RdBu", direction = -1, seed = 22)


## ----warning=FALSE, fig.width = 7.2, fig.height = 4---------------------------
ResIN_out <- ResIN(Core_Items,
                   node_vars = c("legal_abort", "equalize_incomes", "keep_immigrants",
                                 "welfare_spending", "gay_marriage", "protect_environ",
                                 "gun_control", "aid_blacks"), node_covars = c("dem_bias"),
                   node_costats = c("mean"), plot_whichstat = "dem_bias_mean",
                   plot_responselabels = TRUE, left_anchor = "legal_abort_++",
                   plot_title = "Affective preference of Democrats over Republicans", 
                   color_palette = "RdBu", direction = -1, seed = 22)

## ----warning=FALSE------------------------------------------------------------
head(ResIN_out$ResIN_nodeframe[, 8:9], 10)

## ----warning=FALSE, message=FALSE, fig.width = 7.2, fig.height = 4------------
## Further attaching partisan identification
Core_Items <- Core_Items %>% dplyr::mutate(partisan = as.numeric(recode(BrJSocPsychol_2024$Q13, 
                                       "Democrat" = 0,
                                       "Independent" = 1,
                                       "Republican" = 2)))

ResIN_out <- ResIN(Core_Items, node_vars = c("legal_abort", "equalize_incomes", 
                                             "keep_immigrants", "welfare_spending",
                                             "gay_marriage", "protect_environ",
                                             "gun_control", "aid_blacks"), 
                   left_anchor = "legal_abort_++",
                   node_covars = c("dem_bias", "partisan"), node_costats = c("mean", "mean"),
                   plot_ggplot = F)

## Loading the psych package to run the correlation test.
if(!require("psych")) install.packages('psych')
library(psych)
## Partisanship
corr.test(ResIN_out$ResIN_nodeframe$x, ResIN_out$ResIN_nodeframe$partisan_mean)

## Affective polarization
corr.test(ResIN_out$ResIN_nodeframe$x, ResIN_out$ResIN_nodeframe$dem_bias_mean)


## ----echo=TRUE, message=FALSE, warning=FALSE----------------------------------
## Partisanship at the individual level
corr.test(Core_Items$partisan, ResIN_out$ResIN_scores$raw_x)

## Affective polarization at the individual level
corr.test(Core_Items$dem_bias, ResIN_out$ResIN_scores$raw_x)

## ----warning=FALSE, message = FALSE, fig.width = 7.2, fig.height = 4----------
## Let's generate a new, more lean ResIN analysis by omitting network statistics calculations, 
## plot generation, and individual-level scoring. This will optimize the execution time.
ResIN_out <- ResIN(Core_Items, node_vars = c("legal_abort", "equalize_incomes", 
                                             "keep_immigrants", "welfare_spending",
                                             "gay_marriage", "protect_environ",
                                             "gun_control", "aid_blacks"), 
                   node_covars = c("partisan"), node_costats = c("mean"), 
                   left_anchor = "legal_abort_++", network_stats = FALSE,
                   generate_ggplot = FALSE, plot_ggplot = FALSE, save_input = T,
                   ResIN_scores = FALSE, detect_clusters = FALSE)

ResIN_prepped <- ResIN_boots_prepare(ResIN_out, n = 150, boots_type = "resample")

## Running the bootstrap might take a while; uncomment to try yourself
# ResIN_executed <- ResIN_boots_execute(ResIN_prepped, parallel = TRUE, n_cores = 2L)

data("Bootstrap_example")

## Extracting the mean level partisanship per node across all iterations
partisan_means <- ResIN_boots_extract(Bootstrap_example, what = "partisan_mean")

## Extracting the node-level latent space coordinate across all iterations
x_postions <- ResIN_boots_extract(Bootstrap_example, what = "x")

## Correlating each list element and storing results in a new vector
correlations <- list()
for(i in 1:length(partisan_means)){
  correlations[[i]] <- cor(partisan_means[[i]], x_postions[[i]])
}

correlations <- unlist(correlations)

summary(correlations)

## Let's plot the result with 95% CI lines:
correlations <- as.data.frame(correlations)
prob_lines <- quantile(correlations$correlations, c(0.025,0.5, 0.975), na.rm=TRUE) 

if(!require("ggplot2")) install.packages('ggplot2')
library(ggplot2)
ggplot(correlations, aes(x = correlations))+
  geom_density(fill = "lightblue")+
  ggtitle("Density of bootstrapped correlations between node position and partisanship")+
  labs(y = "Probability density", x = "Correlation between ResIN attitude node 
       position and average partisan identity")+
  geom_vline(xintercept = prob_lines[1], color = "darkred",linetype = 2)+
  geom_vline(xintercept = prob_lines[2], color = "black",linetype = 2, size = 1)+
  geom_vline(xintercept = prob_lines[3], color = "darkred",linetype = 2)+
  xlim(c(0.75, 0.92))+
  theme_classic() 


## ----warning=FALSE, message = FALSE, fig.width = 7.2, fig.height = 4----------
ResIN_out <- ResIN(Core_Items, node_vars = c("legal_abort", "equalize_incomes", 
                                             "keep_immigrants", "welfare_spending",
                                             "gay_marriage", "protect_environ",
                                             "gun_control", "aid_blacks"), 
                   seed = 36,
                   plot_ggplot = FALSE,
                   bipartite = TRUE)

ResIN_out$bipartite_output$bipartite_ggraph

## -----------------------------------------------------------------------------
## Easily convert a ResIN object to igraph:
ResIN_igraph <- as.igraph(ResIN_out)
class(ResIN_igraph)

ResIN_qgraph <- as.qgraph(ResIN_out)
class(ResIN_qgraph)

ResIN_gephi <- as.gephi(ResIN_out, file = "ResIN_gephi.csv", dont_save_csv = TRUE)
    ## set dont_save_csv = FALSE to save .cvs files for import to Gephi.