inst/doc/introduction_synth.R

In IRTM: Theory-Driven Item Response Theory (IRT) Models

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

## ----packages, eval=T, echo=T, message=F, warning = FALSE---------------------
## Data prep:
library(tidyverse) # version: tidyverse_2.0.0 
library(dplyr) #version: dplyr_1.1.4
library(stats) # version: stats4
library(fastDummies) # version: fastDummies_1.7.3
library(reshape2) #version: reshape2_1.4.4

## IRT-M estimation:
#devtools::install_github("dasiegel/IRT-M")
library(IRTM) #version 1.00

## Results visualization: 
library(ggplot2)  # version: ggplot2_3.4.4
library(ggridges) #version: ggridges_0.5.6 
library(RColorBrewer) #version: RColorBrewer_1.1-3
library(ggrepel) # version: ggrepel_0.9.5 

## ----load-dat, eval=T, echo=T, message=F, warning = FALSE---------------------

synth_questions <- NULL  # Initialize to avoid R CMD check notes

load("./vdata/synth_questions.rda")
## Convert numeric ordinal responses to factors

ebdatsub <- lapply(ebdatsynth[,], factor) ## that's a list now

## converts the list back into a dataframe:
Y <- dummy_cols(.data=ebdatsub,
                       remove_selected_columns=TRUE)

## remove the .data that dummy_cols adds to the column names
colnames(Y) <- gsub(".data.", '', colnames(Y))

## remove the data objects:
rm(ebdatsub)
rm(ebdatsynth)

## ----load-mcodes, eval=T, echo=T, message=F, warning = F----------------------
load('./vdata/mcodes.rda')

## Only keep M-Codes with loadings or outcomes:
MCodes$encoding <- rowSums(abs(MCodes[,4:9])) 
MCodes <- MCodes[which(MCodes$encoding > 0),]


## ----format-mcodes, eval=T, echo=T, message=F, warning = F--------------------
## Produce a K-coded questions x R-responses data frame:

d <- 6 #number of coded dimensions
mcolumns <- c("QMap", "D1-Culture threat", 
              "D2-ReligionThreat", 
              "D3-Economic Threat",
              "D4-HealthThreat",
              "O1-OutcomeSupportImmigration", "O2-OutcomeSupportEU")

combine <- MCodes[,mcolumns] %>% ## question codes and loadings 
    inner_join(
        Y %>% 
        t() %>% 
        as.data.frame(stringsAsFactors = FALSE) %>% 
        type_convert() %>%
        rownames_to_column(var = "question"),
        by = c("QMap" = "question"  )
    )

M_matrix <- as.data.frame(combine[, 1:(d+1)])

#Reverse the earlier transposition of the observations:
Y_in <- combine[, (d+2):ncol(combine)]%>%
    t() %>%
    as.data.frame()

Y_in <- as.data.frame(sapply(Y_in, as.numeric))

## Take the question names and 
## convert to column names

question <- combine[,1] %>%
    as.data.frame() 
colnames(Y_in) <- question[,1]
rm(combine)
rm(question)

## ----run-irtm, eval=T, echo=T, message=F, warning = FALSE---------------------
d=6
irt <- irt_m(Y_in = Y_in, d = d, M_matrix = M_matrix, nsamp = 1000, nburn=20, thin=1)


## ----theta-average, eval=T, echo=T, message=F, warning = FALSE----------------
avgthetas <- theta_av(irt$theta)


## ----read-idvs, eval=T, echo=T------------------------------------------------

## load idvs:
load("./vdata/synth_idvs.rda")

thetas <- cbind(avgthetas, synthidvs)

## Rename columns for readability:
colnames(thetas)[1:6] <- paste0("Theta", 1:6)
colnames(thetas)[colnames(thetas)=="qb7_2"] <- "MoreBorderControl"

## Cast into factors:
thetas$mediatrust <- as.factor(thetas$mediatrust)
thetas$class <- as.factor(thetas$class)
thetas$polorient <- as.factor(thetas$polorient)

head(thetas)


## ----corr-matrixes, eval=T, echo=T, message=F, warning = FALSE----------------

#Compute correlation matrix of latent dimensions
theta_names <- c("Culture Threat", "Religion Threat", "Economic Threat", "Health Threat", "Support Immigration", "Support EU")
theta_corr <- dim_corr(irt$Sigma, theta_names)
theta_corr


## ----viz-thetas, eval=T, echo=T, echo=T, message=F, warning = FALSE-----------
library(ggplot2) #version: ggplot2_3.4.4 
library(ggridges) #version: ggridges_0.5.6 
library(RColorBrewer) #version: RColorBrewer_1.1-3
library(dplyr) #version: dplyr_1.1.4
library(ggrepel) # version: ggrepel_0.9.5 
library(reshape2) #version: reshape2_1.4.4


## Rename for interpretability:
## Mapping:
## Theta1-Culture threat
## Theta2-ReligionThreat
## Theta3-Economic Threat
## Theta4-HealthThreat
## Theta5-OutcomeSupportImmigration
## Theta6-OutcomeSupportEU

colnames(thetas)[1:6] <-  recode(colnames(thetas)[1:6],
                                 "Theta1" = "Culture Threat",
                                 "Theta2" = "Religion Threat",
                                 "Theta3" = "Economic Threat",
                                 "Theta4" = "Health Threat",
                                 "Theta5" = "Support Immigration",
                                 "Theta6" = "Support EU")

#Save aggregate plot
ggbase <- irt_vis(d = d, T_out = thetas, sub_name = NULL, out_file = "ebirtm-synth.png")


## ----medtrust-viz, eval=T, echo=T, message=F, warning = FALSE-----------------

#Save plot subset by media trust
ggmt <- irt_vis(d = d, T_out = thetas, sub_name = "mediatrust", out_file = "theta-media-synth.png")


## ----lambdas, eval=TRUE, echo=T, message=F, warning = FALSE-------------------

#Extract relevant substantive notes and create data frame with them and item codes
filtered_MCodes <- MCodes[MCodes[[2]] %in% M_matrix$QMap, , drop = FALSE]
M_df <- data.frame(QMap = M_matrix$QMap, sn = filtered_MCodes[[3]])

#Explore item loadings
lambdas <- get_lambdas(irt$lambda, item_names = M_df$QMap, dim_names = theta_names, item_elab = M_df$sn)
average_lambdas <- lambdas[[1]]
highest_lambdas <- lambdas[[2]]
average_lambdas
highest_lambdas