9 Observed Response Patterns

9.1 Load Packages

library(naniar)
library(tidyverse)
library(haven)
library(glue)
library(MplusAutomation)
library(here)
library(janitor)
library(gt)
library(tidyLPA)
library(pisaUSA15)
library(cowplot)
library(filesstrings)
library(patchwork)
library(RcppAlgos)

9.2 Prepare Data

df_bully <- read_csv(here("data", "crdc_lca_data.csv")) %>% 
  clean_names() %>% 
  dplyr::select(report_dis, report_race, report_sex, counselors_fte, psych_fte, law_fte)

Continuing the LCA example (3) in this bookdown, save response frequencies for the 3-class model with response is _____.dat under SAVEDATA.


patterns  <- mplusObject(
  
  TITLE = "C3 LCA - Save response patterns", 
  
  VARIABLE = 
  "categorical = report_dis-law_fte; 
   usevar =  report_dis-law_fte;
   classes = c(3);",
  
  ANALYSIS = 
   "estimator = mlr; 
    type = mixture;
    starts = 0;
    processors = 10;
    optseed = 802779;",
  
  SAVEDATA = 
   "File=savedata.dat;
    Save=cprob;
    
    ! Code to save response frequency data 
    
    response is resp_patterns.dat;",
  
  OUTPUT = "residual patterns tech11 tech14",
  
  usevariables = colnames(df_bully),
  rdata = df_bully)

patterns_fit <- mplusModeler(patterns,
                dataout=here("mplus", "bully.dat"),
                modelout=here("mplus", "patterns.inp") ,
                check=TRUE, run = TRUE, hashfilename = FALSE)

Read in observed response pattern data and relabel the columns

# Read in response frequency data that we just created:
patterns <- read_table(here("mplus", "resp_patterns.dat"),
                        col_names=FALSE, na = "*") 

# Extract the column names
names <- names(readModels(here("mplus", "patterns.out"))[['savedata']]) 

# Add the names back to the dataset
colnames(patterns) <- c("Frequency", names)

Create a table with the top 5 unconditional response pattern, then top of conditional response pattern for each modal class assignment

# Order responses by highest frequency
order_highest <- patterns %>% 
  arrange(desc(Frequency)) 

# Loop `patterns` data to list top 5 conditional response patterns for each class
loop_cond  <- lapply(1:max(patterns$C), function(k) {       
order_cond <- patterns %>%                    
  filter(C == k) %>%                    
  arrange(desc(Frequency)) %>%                
  head(5)                                     
  })                                          

# Convert loop into data frame
table_data <- as.data.frame(bind_rows(loop_cond))

# Combine unconditional and conditional responses patterns
response_patterns <-  rbind(order_highest[1:5,], table_data)

Finally, use gt to make a nicely formatted table

resp_table <- response_patterns %>% 
  gt() %>%
    tab_header(
    title = "Observed Response Patterns",
    subtitle = html("Response patterns, estimated frequencies, estimated posterior class probabilities and modal assignments")) %>% 
    tab_source_note(
    source_note = md("Data Source: **Civil Rights Data Collection (CRDC)**")) %>%
    cols_label(
      Frequency = html("<i>f</i><sub>r</sub>"),
    REPORT_D = "Harrassment: Disability",
    REPORT_R = "Harrassment: Race",
    REPORT_S = "Harrassment: Sex",
    COUNSELO = "Staff: Counselor",
    PSYCH_FT = "Staff: Psychologist",
    LAW_FTE = "Staff: Law Enforcement",
    CPROB1 = html("P<sub><i>k</i></sub>=1"),
    CPROB2 = html("P<sub><i>k</i></sub>=2"),
    CPROB3 = html("P<sub><i>k</i></sub>=3"),
    C = md("*k*")) %>% 
  tab_row_group(
    label = "Unconditional response patterns",
    rows = 1:5) %>%
  tab_row_group(
    label = md("*k* = 1 Conditional response patterns"),
    rows = 6:10) %>% #EDIT THESE VALUES BASED ON THE LAST COLUMN
  tab_row_group(
    label = md("*k* = 2 Conditional response patterns"),
    rows = 11:15)  %>% #EDIT THESE VALUES BASED ON THE LAST COLUMN
  tab_row_group(
    label = md("*k* = 3 Conditional response patterns"),
    rows = 16:20)  %>% #EDIT THESE VALUES BASED ON THE LAST COLUMN  
    row_group_order(
      groups = c("Unconditional response patterns",
                 md("*k* = 1 Conditional response patterns"),
                 md("*k* = 2 Conditional response patterns"),
                 md("*k* = 3 Conditional response patterns"))) %>% 
    tab_footnote(
    footnote = html(
      "<i>Note.</i> <i>f</i><sub>r</sub> = response pattern frequency; P<sub><i>k</i></sub> = posterior class probabilities"
    )
  ) %>% 
  cols_align(align = "center") %>% 
  opt_align_table_header(align = "left") %>% 
  gt::tab_options(table.font.names = "Times New Roman")

resp_table

f_r	Harrassment: Disability	Harrassment: Race	Harrassment: Sex	Staff: Counselor	Staff: Psychologist	Staff: Law Enforcement	P_k=1	P_k=2	P_k=3	k
Observed Response Patterns
Response patterns, estimated frequencies, estimated posterior class probabilities and modal assignments
Unconditional response patterns
525	0	0	0	0	0	0	0.023	0.002	0.976	3
299	0	0	0	0	1	0	0.139	0.007	0.854	3
293	0	0	0	1	0	0	0.146	0.004	0.850	3
251	0	0	0	1	1	0	0.541	0.009	0.449	1
75	0	0	0	1	1	1	0.959	0.011	0.030	1
k = 1 Conditional response patterns
251	0	0	0	1	1	0	0.541	0.009	0.449	1
75	0	0	0	1	1	1	0.959	0.011	0.030	1
72	0	0	1	1	1	0	0.803	0.088	0.108	1
38	0	0	1	0	1	0	0.431	0.139	0.430	1
34	0	0	0	0	1	1	0.789	0.027	0.184	1
k = 2 Conditional response patterns
24	0	1	0	0	1	0	0.000	0.561	0.439	2
20	0	1	1	0	1	0	0.000	0.981	0.019	2
19	0	1	1	1	1	0	0.000	0.992	0.008	2
18	0	1	1	1	0	0	0.000	0.967	0.033	2
12	0	1	1	1	1	1	0.000	1.000	0.000	2
k = 3 Conditional response patterns
525	0	0	0	0	0	0	0.023	0.002	0.976	3
299	0	0	0	0	1	0	0.139	0.007	0.854	3
293	0	0	0	1	0	0	0.146	0.004	0.850	3
36	0	0	1	0	0	0	0.117	0.060	0.823	3
27	0	0	0	NA	NA	NA	0.236	0.006	0.758	3
Data Source: Civil Rights Data Collection (CRDC)
Note. f_r = response pattern frequency; P_k = posterior class probabilities

Save table:

gtsave(resp_table, here("figures","resp_table.png"))

8 Item Mean Plots

10 Classification Diagnostics