Sex Differences in Latent Profiles of Personality and Imagination Across College Disciplines

#Load packages and dataset

knitr::opts_chunk$set(
    echo = TRUE,
    message = FALSE,
    warning = FALSE,
    fig.path = "plots/",   
  dev = "png",      
  dpi = 300,          
  fig.width = 8,        
  fig.height = 6           
)
# Load libraries quietly
suppressPackageStartupMessages({
# load packages
library(readxl) #import data
library(here) #import data
library(summarytools)
library(psych)
library(ggplot2)
library("writexl")
library("apaTables")
library(tidyLPA)
library(dplyr)
library(tidyverse)
library(mclust)
library(ltm)
library(tidyr)
library(MASS)
library(lavaan)
library(lavaanPlot)
library(semTools)
library(effectsize)
library(MixAll)
library(tidyLPA)
library(nnet)
library(stats)
library(tidyverse)
library("DescTools")
library(GGally)
library(flextable)

})

#Only select University Students by Age less than 25 and Students who Identify as Male or Female. #Clean up data and select before any analyses

filtered_df <- data %>%
  filter(SEX %in% c("Female", "Male"),
         !COLLEGENAME %in% c("Merchandising, Hospitality, and Tourism", "Information"),
         !RACE %in% c("American Indian/Alaskan Native","Native Hawaiian Pacific Islander"))

filtered_df$COLLEGENAME <- droplevels(filtered_df$COLLEGENAME)
filtered_df$RACE <- droplevels(filtered_df$RACE)

table(filtered_df$AGE)

## 
##  18  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37 
##   5 185 273 228 213 123  90  58  50  35  39  23  30  21  26  16  11  10  13   7 
##  38  39  40  41  42  43  44  45  46  47  48  49 
##  11   6   3   5   6   4   7   3   5   8   4  42

mean(filtered_df$AGE)

## [1] 24.38718

sd(filtered_df$AGE)

## [1] 6.824481

table(filtered_df$SEX)

## 
## Female   Male 
##   1028    532

prop.table(table(filtered_df$SEX))

## 
##    Female      Male 
## 0.6589744 0.3410256

data$SEX <-as.factor(data$SEX)

table(filtered_df$RACE)

## 
##                  Asian Black/African American        Hispanic/Latinx 
##                    142                    103                    282 
##      Two or More Races        White/Caucasian 
##                    138                    895

data$RACE <-as.factor(data$RACE)
prop.table(table(filtered_df$RACE))

## 
##                  Asian Black/African American        Hispanic/Latinx 
##             0.09102564             0.06602564             0.18076923 
##      Two or More Races        White/Caucasian 
##             0.08846154             0.57371795

table(filtered_df$COLLEGENAME)

## 
##                         Business                        Education 
##                              161                              228 
##                      Engineering        Health and Public Service 
##                              152                              135 
##                       Journalism Liberal Arts and Social Sciences 
##                               42                              470 
##                            Music                          Science 
##                               73                              210 
##           Visual Arts and Design 
##                               89

data$COLLEGENAME <-as.factor(data$COLLEGENAME)
prop.table(table(filtered_df$COLLEGENAME))

## 
##                         Business                        Education 
##                       0.10320513                       0.14615385 
##                      Engineering        Health and Public Service 
##                       0.09743590                       0.08653846 
##                       Journalism Liberal Arts and Social Sciences 
##                       0.02692308                       0.30128205 
##                            Music                          Science 
##                       0.04679487                       0.13461538 
##           Visual Arts and Design 
##                       0.05705128

#install.packages(c("flextable", "officer", "dplyr"))
# Age summary
library(dplyr)
library(flextable)
library(officer)

# AGE summary
age_summary <- data.frame(
  Category = "Age",
  Variable = "Mean (SD)",
  Count = round(mean(filtered_df$AGE, na.rm = TRUE), 2),
  Proportion = round(sd(filtered_df$AGE, na.rm = TRUE), 2))

# SEX summary
sex_counts <- as.data.frame(table(filtered_df$SEX))
sex_props <- as.data.frame(prop.table(table(filtered_df$SEX)))
sex_summary <- sex_counts %>%
  rename(Variable = Var1, Count = Freq) %>%
  mutate(Proportion = round(sex_props$Freq, 3),
         Category = "Sex") %>%
  dplyr::select(Category, Variable, Count, Proportion)

# RACE summary
race_counts <- as.data.frame(table(filtered_df$RACE))
race_props <- as.data.frame(prop.table(table(filtered_df$RACE)))
race_summary <- race_counts %>%
  rename(Variable = Var1, Count = Freq) %>%
  mutate(Proportion = round(race_props$Freq, 3),
         Category = "Race") %>%
  dplyr::select(Category, Variable, Count, Proportion)

# Honors College summary
honors_counts <- as.data.frame(table(filtered_df$UNTHONOR))
honors_props <- as.data.frame(prop.table(table(filtered_df$UNTHONOR)))
honors_summary <- honors_counts %>%
  rename(Variable = Var1, Count = Freq) %>%
  mutate(Proportion = round(honors_props$Freq, 3),
         Category = "Honors College") %>%
  dplyr::select(Category, Variable, Count, Proportion)

# COLLEGENAME summary
college_counts <- as.data.frame(table(filtered_df$COLLEGENAME))
college_props <- as.data.frame(prop.table(table(filtered_df$COLLEGENAME)))
college_summary <- college_counts %>%
  rename(Variable = Var1, Count = Freq) %>%
  mutate(Proportion = round(college_props$Freq, 3),
         Category = "College") %>%
  dplyr::select(Category, Variable, Count, Proportion)

# Combine all
demo_summary <- bind_rows(sex_summary, race_summary, honors_summary, college_summary)

# Format proportion as percentages
demographics <- demo_summary %>%
  mutate(Proportion = paste0(round(Proportion * 100, 1), "%"))

# Create flextables
age_ft <- flextable(age_summary)
demo_ft <- flextable(demographics)

# Create and export Word document
doc <- read_docx() %>%
  body_add_par("Demographic Summary", style = "heading 1") %>%
  body_add_flextable(demo_ft)

print(doc, target = "Demographic_Summary.docx")

#Personality Scale This section examines the reliability and outliers for each of the Big Five traits

#define columns to reverse code
reverse_cols = c("P1", "P2","P3","P4","P5","P16","P17","P18","P19","P20",
                 "P26","P27","P28","P29","P30","P36","P37","P38","P39","P40",
                 "P46","P47","P48","P49","P50")

#reverse code Q2 and Q5 columns
filtered_df[ , reverse_cols] = 6 - filtered_df[ , reverse_cols]
filtered_df <- as_tibble(filtered_df)

IPIP_Ext <- filtered_df %>% dplyr::select(P11, P12, P13, P14, P15, P16, P17, P18,   P19, P20)
IPIP_Open <- filtered_df %>% dplyr::select(P21, P22, P23,   P24, P25, P26, P27, P28, P29, P30)
IPIP_Neu <- filtered_df %>% dplyr::select(P1,   P2, P3, P4, P5, P6, P7, P8, P9, P10)
IPIP_Agree <- filtered_df %>% dplyr::select(P31, P32,   P33, P34,   P35, P36, P37, P38, P39, P40)
IPIP_Cons <- filtered_df %>% dplyr::select(P41, P42, P43,   P44, P45, P46, P47, P48, P49,   P50)

cronbach.alpha(IPIP_Ext, CI=TRUE, standardized=TRUE)

## 
## Standardized Cronbach's alpha for the 'IPIP_Ext' data-set
## 
## Items: 10
## Sample units: 1560
## alpha: 0.895
## 
## Bootstrap 95% CI based on 1000 samples
##  2.5% 97.5% 
## 0.887 0.903

cronbach.alpha(IPIP_Open, CI=TRUE, standardized=TRUE)

## 
## Standardized Cronbach's alpha for the 'IPIP_Open' data-set
## 
## Items: 10
## Sample units: 1560
## alpha: 0.795
## 
## Bootstrap 95% CI based on 1000 samples
##  2.5% 97.5% 
## 0.776 0.811

cronbach.alpha(IPIP_Neu, CI=TRUE, standardized=TRUE)

## 
## Standardized Cronbach's alpha for the 'IPIP_Neu' data-set
## 
## Items: 10
## Sample units: 1560
## alpha: 0.872
## 
## Bootstrap 95% CI based on 1000 samples
##  2.5% 97.5% 
## 0.861 0.880

cronbach.alpha(IPIP_Agree, CI=TRUE, standardized=TRUE)

## 
## Standardized Cronbach's alpha for the 'IPIP_Agree' data-set
## 
## Items: 10
## Sample units: 1560
## alpha: 0.802
## 
## Bootstrap 95% CI based on 1000 samples
##  2.5% 97.5% 
## 0.787 0.818

cronbach.alpha(IPIP_Cons, CI=TRUE, standardized=TRUE)

## 
## Standardized Cronbach's alpha for the 'IPIP_Cons' data-set
## 
## Items: 10
## Sample units: 1560
## alpha: 0.864
## 
## Bootstrap 95% CI based on 1000 samples
##  2.5% 97.5% 
## 0.853 0.875

#Create composites for IPIP
filtered_df$Extra <- rowMeans(filtered_df[,c("P11", "P12", "P13","P14", "P15", "P16", "P17", "P18", "P19", "P20")], na.rm=TRUE)
filtered_df$Open <- rowMeans(filtered_df[,c("P21", "P22", "P23",    "P24", "P25", "P26", "P27", "P28", "P29", "P30")], na.rm=TRUE)
filtered_df$EmotStab <- rowMeans(filtered_df[,c("P1", "P2", "P3",   "P4",   "P5",   "P6",   "P7",   "P8",   "P9",   "P10")], na.rm=TRUE)
filtered_df$Agree <- rowMeans(filtered_df[,c("P31","P32",   "P33", "P34",   "P35", "P36", "P37", "P38", "P39", "P40")], na.rm=TRUE)
filtered_df$Conscientious <- rowMeans(filtered_df[,c("P41", "P42", "P43",   "P44","P45", "P46", "P47", "P48", "P49",    "P50")], na.rm=TRUE)

#Imagination Scale This section examines the reliability and outliers for each of the factors of the Imagination scale from Chang et al. (Initiating Ideas, Conceiving Ideas, Transforming Ideas)

## lavaan 0.6-19 ended normally after 45 iterations
## 
##   Estimator                                         ML
##   Optimization method                           NLMINB
##   Number of model parameters                        57
## 
##   Number of observations                          1560
## 
## Model Test User Model:
##                                                       
##   Test statistic                              1487.062
##   Degrees of freedom                               243
##   P-value (Chi-square)                           0.000
## 
## Model Test Baseline Model:
## 
##   Test statistic                             18640.162
##   Degrees of freedom                               276
##   P-value                                        0.000
## 
## User Model versus Baseline Model:
## 
##   Comparative Fit Index (CFI)                    0.932
##   Tucker-Lewis Index (TLI)                       0.923
## 
## Loglikelihood and Information Criteria:
## 
##   Loglikelihood user model (H0)             -47648.225
##   Loglikelihood unrestricted model (H1)     -46904.694
##                                                       
##   Akaike (AIC)                               95410.450
##   Bayesian (BIC)                             95715.539
##   Sample-size adjusted Bayesian (SABIC)      95534.463
## 
## Root Mean Square Error of Approximation:
## 
##   RMSEA                                          0.057
##   90 Percent confidence interval - lower         0.055
##   90 Percent confidence interval - upper         0.060
##   P-value H_0: RMSEA <= 0.050                    0.000
##   P-value H_0: RMSEA >= 0.080                    0.000
## 
## Standardized Root Mean Square Residual:
## 
##   SRMR                                           0.041
## 
## Parameter Estimates:
## 
##   Standard errors                             Standard
##   Information                                 Expected
##   Information saturated (h1) model          Structured
## 
## Latent Variables:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   initiating =~                                       
##     ICS1              1.000                           
##     ICS2              0.821    0.033   24.885    0.000
##     ICS3              1.158    0.043   27.226    0.000
##     ICS4              1.228    0.041   29.630    0.000
##     ICS5              1.081    0.039   27.405    0.000
##     ICS6              1.143    0.041   27.573    0.000
##     ICS7              1.058    0.045   23.586    0.000
##     ICS9              0.896    0.041   21.990    0.000
##   conceiving =~                                       
##     ICS11             1.000                           
##     ICS12             1.007    0.043   23.399    0.000
##     ICS14             0.948    0.055   17.139    0.000
##     ICS15             0.926    0.054   17.235    0.000
##     ICS16             0.843    0.043   19.464    0.000
##     ICS18             0.884    0.048   18.505    0.000
##     ICS19             1.067    0.049   21.663    0.000
##     ICS20             1.025    0.051   20.184    0.000
##     ICS21             1.125    0.049   22.777    0.000
##   transforming =~                                     
##     ICS23             1.000                           
##     ICS24             1.027    0.038   27.075    0.000
##     ICS25             1.087    0.048   22.852    0.000
##     ICS26             0.983    0.042   23.149    0.000
##     ICS27             0.992    0.047   21.044    0.000
##     ICS28             1.105    0.046   24.031    0.000
##     ICS29             1.051    0.041   25.363    0.000
## 
## Covariances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   initiating ~~                                       
##     conceiving        0.399    0.025   15.931    0.000
##     transforming      0.411    0.025   16.670    0.000
##   conceiving ~~                                       
##     transforming      0.424    0.026   16.022    0.000
##  .ICS5 ~~                                             
##    .ICS6              0.138    0.017    8.105    0.000
##  .ICS11 ~~                                            
##    .ICS12             0.264    0.024   10.856    0.000
##  .ICS14 ~~                                            
##    .ICS15             0.448    0.032   14.055    0.000
##  .ICS23 ~~                                            
##    .ICS24             0.151    0.017    8.796    0.000
##  .ICS24 ~~                                            
##    .ICS25             0.158    0.018    8.931    0.000
##  .ICS28 ~~                                            
##    .ICS29             0.126    0.015    8.445    0.000
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##    .ICS1              0.591    0.024   25.132    0.000
##    .ICS2              0.458    0.018   25.498    0.000
##    .ICS3              0.623    0.026   24.359    0.000
##    .ICS4              0.441    0.020   22.231    0.000
##    .ICS5              0.516    0.022   23.843    0.000
##    .ICS6              0.560    0.024   23.739    0.000
##    .ICS7              0.925    0.036   25.934    0.000
##    .ICS9              0.838    0.032   26.352    0.000
##    .ICS11             0.859    0.033   26.050    0.000
##    .ICS12             0.825    0.032   25.951    0.000
##    .ICS14             1.141    0.043   26.686    0.000
##    .ICS15             1.068    0.040   26.663    0.000
##    .ICS16             0.559    0.022   25.952    0.000
##    .ICS18             0.754    0.029   26.322    0.000
##    .ICS19             0.525    0.021   24.530    0.000
##    .ICS20             0.702    0.027   25.599    0.000
##    .ICS21             0.418    0.018   23.136    0.000
##    .ICS23             0.677    0.027   25.318    0.000
##    .ICS24             0.546    0.022   24.551    0.000
##    .ICS25             0.689    0.028   24.889    0.000
##    .ICS26             0.534    0.021   24.851    0.000
##    .ICS27             0.808    0.031   25.870    0.000
##    .ICS28             0.545    0.023   23.572    0.000
##    .ICS29             0.365    0.016   22.294    0.000
##     initiating        0.568    0.037   15.292    0.000
##     conceiving        0.457    0.038   12.141    0.000
##     transforming      0.488    0.036   13.649    0.000

## lavaan 0.6-19 ended normally after 45 iterations
## 
##   Estimator                                         ML
##   Optimization method                           NLMINB
##   Number of model parameters                        57
## 
##   Number of observations                          1560
## 
## Model Test User Model:
##                                                       
##   Test statistic                              1487.062
##   Degrees of freedom                               243
##   P-value (Chi-square)                           0.000
## 
## Model Test Baseline Model:
## 
##   Test statistic                             18640.162
##   Degrees of freedom                               276
##   P-value                                        0.000
## 
## User Model versus Baseline Model:
## 
##   Comparative Fit Index (CFI)                    0.932
##   Tucker-Lewis Index (TLI)                       0.923
## 
## Loglikelihood and Information Criteria:
## 
##   Loglikelihood user model (H0)             -47648.225
##   Loglikelihood unrestricted model (H1)     -46904.694
##                                                       
##   Akaike (AIC)                               95410.450
##   Bayesian (BIC)                             95715.539
##   Sample-size adjusted Bayesian (SABIC)      95534.463
## 
## Root Mean Square Error of Approximation:
## 
##   RMSEA                                          0.057
##   90 Percent confidence interval - lower         0.055
##   90 Percent confidence interval - upper         0.060
##   P-value H_0: RMSEA <= 0.050                    0.000
##   P-value H_0: RMSEA >= 0.080                    0.000
## 
## Standardized Root Mean Square Residual:
## 
##   SRMR                                           0.041
## 
## Parameter Estimates:
## 
##   Standard errors                             Standard
##   Information                                 Expected
##   Information saturated (h1) model          Structured
## 
## Latent Variables:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   initiating =~                                       
##     ICS1              1.000                           
##     ICS2              0.821    0.033   24.885    0.000
##     ICS3              1.158    0.043   27.226    0.000
##     ICS4              1.228    0.041   29.630    0.000
##     ICS5              1.081    0.039   27.405    0.000
##     ICS6              1.143    0.041   27.573    0.000
##     ICS7              1.058    0.045   23.586    0.000
##     ICS9              0.896    0.041   21.990    0.000
##   conceiving =~                                       
##     ICS11             1.000                           
##     ICS12             1.007    0.043   23.399    0.000
##     ICS14             0.948    0.055   17.139    0.000
##     ICS15             0.926    0.054   17.235    0.000
##     ICS16             0.843    0.043   19.464    0.000
##     ICS18             0.884    0.048   18.505    0.000
##     ICS19             1.067    0.049   21.663    0.000
##     ICS20             1.025    0.051   20.184    0.000
##     ICS21             1.125    0.049   22.777    0.000
##   transforming =~                                     
##     ICS23             1.000                           
##     ICS24             1.027    0.038   27.075    0.000
##     ICS25             1.087    0.048   22.852    0.000
##     ICS26             0.983    0.042   23.149    0.000
##     ICS27             0.992    0.047   21.044    0.000
##     ICS28             1.105    0.046   24.031    0.000
##     ICS29             1.051    0.041   25.363    0.000
## 
## Covariances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##   initiating ~~                                       
##     conceiving        0.399    0.025   15.931    0.000
##     transforming      0.411    0.025   16.670    0.000
##   conceiving ~~                                       
##     transforming      0.424    0.026   16.022    0.000
##  .ICS5 ~~                                             
##    .ICS6              0.138    0.017    8.105    0.000
##  .ICS11 ~~                                            
##    .ICS12             0.264    0.024   10.856    0.000
##  .ICS14 ~~                                            
##    .ICS15             0.448    0.032   14.055    0.000
##  .ICS23 ~~                                            
##    .ICS24             0.151    0.017    8.796    0.000
##  .ICS24 ~~                                            
##    .ICS25             0.158    0.018    8.931    0.000
##  .ICS28 ~~                                            
##    .ICS29             0.126    0.015    8.445    0.000
## 
## Variances:
##                    Estimate  Std.Err  z-value  P(>|z|)
##    .ICS1              0.591    0.024   25.132    0.000
##    .ICS2              0.458    0.018   25.498    0.000
##    .ICS3              0.623    0.026   24.359    0.000
##    .ICS4              0.441    0.020   22.231    0.000
##    .ICS5              0.516    0.022   23.843    0.000
##    .ICS6              0.560    0.024   23.739    0.000
##    .ICS7              0.925    0.036   25.934    0.000
##    .ICS9              0.838    0.032   26.352    0.000
##    .ICS11             0.859    0.033   26.050    0.000
##    .ICS12             0.825    0.032   25.951    0.000
##    .ICS14             1.141    0.043   26.686    0.000
##    .ICS15             1.068    0.040   26.663    0.000
##    .ICS16             0.559    0.022   25.952    0.000
##    .ICS18             0.754    0.029   26.322    0.000
##    .ICS19             0.525    0.021   24.530    0.000
##    .ICS20             0.702    0.027   25.599    0.000
##    .ICS21             0.418    0.018   23.136    0.000
##    .ICS23             0.677    0.027   25.318    0.000
##    .ICS24             0.546    0.022   24.551    0.000
##    .ICS25             0.689    0.028   24.889    0.000
##    .ICS26             0.534    0.021   24.851    0.000
##    .ICS27             0.808    0.031   25.870    0.000
##    .ICS28             0.545    0.023   23.572    0.000
##    .ICS29             0.365    0.016   22.294    0.000
##     initiating        0.568    0.037   15.292    0.000
##     conceiving        0.457    0.038   12.141    0.000
##     transforming      0.488    0.036   13.649    0.000

##          chisq             df         pvalue            cfi            tli 
##       1487.062        243.000          0.000          0.932          0.923 
##          rmsea rmsea.ci.lower rmsea.ci.upper           srmr 
##          0.057          0.055          0.060          0.041

## 
## Standardized Cronbach's alpha for the 'ICS_Init' data-set
## 
## Items: 8
## Sample units: 1560
## alpha: 0.89
## 
## Bootstrap 95% CI based on 1000 samples
##  2.5% 97.5% 
## 0.879 0.899

## 
## Standardized Cronbach's alpha for the 'ICS_Conc' data-set
## 
## Items: 9
## Sample units: 1560
## alpha: 0.851
## 
## Bootstrap 95% CI based on 1000 samples
##  2.5% 97.5% 
## 0.838 0.864

## 
## Standardized Cronbach's alpha for the 'ICS_Trans' data-set
## 
## Items: 7
## Sample units: 1560
## alpha: 0.87
## 
## Bootstrap 95% CI based on 1000 samples
##  2.5% 97.5% 
## 0.858 0.882

## < table of extent 0 >

## Multivariate
## FALSE  TRUE 
##  1549    11

#Latent Profile/Cluster Analysis (LPA) - continuous questions ##Research Question 1 ———- ##What latent profiles of personality and imagination exist among university students?

set.seed(2025)
##Do patterns exist among latent constructs of personality and imagination among a sample of college students?
vLPA <- filtered_df %>% 
  dplyr::select(Initiate, Conceive, Transform, Extra, Open, EmotStab, Agree, Conscientious) %>%
  single_imputation() %>%
  scale() %>%
  estimate_profiles(1:5)
vLPA

## tidyLPA analysis using mclust: 
## 
##  Model Classes AIC      BIC      Entropy prob_min prob_max n_min n_max BLRT_p
##  1     1       35440.70 35526.34 1.00    1.00     1.00     1.00  1.00        
##  1     2       33497.77 33631.58 0.78    0.92     0.95     0.43  0.57  0.01  
##  1     3       32839.51 33021.49 0.80    0.85     0.92     0.11  0.53  0.01  
##  1     4       32555.28 32785.43 0.72    0.79     0.91     0.14  0.31  0.01  
##  1     5       32169.11 32447.44 0.77    0.74     0.91     0.06  0.35  0.01

plot_profiles(vLPA)

fit_df <- get_fit(vLPA)

apa_lpa_fits <- fit_df %>%
  dplyr::select(Model, Classes, AIC, BIC, SABIC, Entropy, BLRT_p) %>%
  rename(
    `# of Classes` = Classes,
    `Adjusted BIC` = SABIC,
    `BLRT p-value` = BLRT_p
  ) %>%
  mutate(across(c(AIC, BIC, `Adjusted BIC`, Entropy, `BLRT p-value`), round, 3))

library(apaTables)
library(officer)
# Check your object
str(apa_lpa_fits)  # Make sure it's a data frame or tibble

## tibble [5 × 7] (S3: tbl_df/tbl/data.frame)
##  $ Model       : num [1:5] 1 1 1 1 1
##  $ # of Classes: num [1:5] 1 2 3 4 5
##  $ AIC         : num [1:5] 35441 33498 32840 32555 32169
##  $ BIC         : num [1:5] 35526 33632 33021 32785 32447
##  $ Adjusted BIC: num [1:5] 35476 33552 32913 32649 32282
##  $ Entropy     : num [1:5] 1 0.779 0.8 0.721 0.768
##  $ BLRT p-value: num [1:5] NA 0.01 0.01 0.01 0.01

# Create flextable
fit_table <- flextable(apa_lpa_fits) %>%
  set_caption("Fit Indices for Latent Profile Models") %>%
  autofit()

# Create Word doc with flextable
fit_table_doc <- read_docx() %>%
  body_add_par("Table 1", style = "heading 1") %>%
  body_add_flextable(fit_table)

# Save Word document
print(fit_table_doc, target = "fit_table_output.docx")

##Profile 2

##Profile 3

LPA3_plot = plot_profiles(Class3LPA,)

LPA3_plot +
  scale_x_continuous(
    breaks = 1:8,  # 
    labels = c(
      "Initiating", "Conceiving", "Transforming", "Extraversion", 
      "Openness", "Emotional Stability", "Agreeableness", "Conscientiousness")) +
  scale_color_manual(
    values = c("1" = "darkgrey", "2" = "blue", "3" = "black"),
    labels = c("Reactive Realists", "Balanced Visionaries","Reserved Idealists")
  ) +
  guides(
    shape = "none",  
    linetype = "none" 
  ) + labs(color = "Profiles", y = "Mean Value", x = "Imagination & Personality Subscales") +
  theme(legend.position = "right") + theme_bw() + theme(text=element_text(size=12,  family="serif"), title = element_text(face = "bold.italic", color = "black",size = 12), axis.title = element_text(face = "bold", color = "black",size = 14),legend.position="bottom", legend.text = element_text(size = 12),legend.title = element_text(size = 14), axis.text = element_text(face = "bold", color = "black", size = 10),axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)  
  )

#ggsave("my_plot.png", plot = LPA3_plot, width = 8, height = 6, dpi = 300)

#Compare models with LMR Statistic

##       Comparison   Null_LL    Alt_LL Null_Params Alt_Params LMR_Stat DF
## 1 2 vs 3 Classes -11878.35 -11816.11          17         25   124.48  8
##     p_value
## 1 3.928e-23

##       Comparison   Null_LL    Alt_LL Null_Params Alt_Params LMR_Stat DF p_value
## 1 3 vs 5 Classes -11816.11 -11820.53          25         41    -8.84 16       1

#We chose to continue with a 3 Profile Solution from entropy, AIC/BIC, the % of students in each grouping, and added interpretable complexity

## [1] "Reactive Realists"    "Balanced Visionaries" "Reserved Idealists"

#Research Question 2 ——— To what extent does latent profiles of personality and imagination differ by sex among university students?

## # A tibble: 3 × 1
##   Class
##   <int>
## 1   166
## 2   562
## 3   832

## # A tibble: 32 × 2
##      AGE Total_age
##    <dbl>     <int>
##  1    18         5
##  2    19       185
##  3    20       273
##  4    21       228
##  5    22       213
##  6    23       123
##  7    24        90
##  8    25        58
##  9    26        50
## 10    27        35
## # ℹ 22 more rows

## # A tibble: 83 × 3
## # Groups:   AGE [32]
##      AGE Class                age_Class
##    <dbl> <fct>                    <int>
##  1    18 Reactive Realists            1
##  2    18 Balanced Visionaries         1
##  3    18 Reserved Idealists           3
##  4    19 Reactive Realists           19
##  5    19 Balanced Visionaries        63
##  6    19 Reserved Idealists         103
##  7    20 Reactive Realists           30
##  8    20 Balanced Visionaries        74
##  9    20 Reserved Idealists         169
## 10    21 Reactive Realists           30
## # ℹ 73 more rows

## # A tibble: 2 × 2
##   SEX    Total_Sex
##   <chr>      <int>
## 1 Female      1028
## 2 Male         532

## # A tibble: 6 × 3
## # Groups:   SEX [2]
##   SEX    Class                sex_Class
##   <chr>  <fct>                    <int>
## 1 Female Reactive Realists          108
## 2 Female Balanced Visionaries       350
## 3 Female Reserved Idealists         570
## 4 Male   Reactive Realists           58
## 5 Male   Balanced Visionaries       212
## 6 Male   Reserved Idealists         262

## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value Pr(>F)
## group    1  0.0489 0.8251
##       1558

## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value  Pr(>F)  
## group    1  4.9918 0.02561 *
##       1558                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value  Pr(>F)  
## group    1  4.9918 0.02561 *
##       1558                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

## 
##  Fisher's Exact Test for Count Data
## 
## data:  sex_tab
## p-value = 0.05365
## alternative hypothesis: two.sided

## 
##  Kruskal-Wallis rank sum test
## 
## data:  new_classdata$Class by new_classdata$SEX
## Kruskal-Wallis chi-squared = 4.3038, df = 1, p-value = 0.03803

## # A tibble: 5 × 2
##   RACE                   Total_race
##   <fct>                       <int>
## 1 Asian                         142
## 2 Black/African American        103
## 3 Hispanic/Latinx               282
## 4 Two or More Races             138
## 5 White/Caucasian               895

## # A tibble: 15 × 3
## # Groups:   RACE [5]
##    RACE                   Class                race_Class
##    <fct>                  <fct>                     <int>
##  1 Asian                  Reactive Realists            17
##  2 Asian                  Balanced Visionaries         35
##  3 Asian                  Reserved Idealists           90
##  4 Black/African American Reactive Realists            12
##  5 Black/African American Balanced Visionaries         45
##  6 Black/African American Reserved Idealists           46
##  7 Hispanic/Latinx        Reactive Realists            38
##  8 Hispanic/Latinx        Balanced Visionaries         89
##  9 Hispanic/Latinx        Reserved Idealists          155
## 10 Two or More Races      Reactive Realists            14
## 11 Two or More Races      Balanced Visionaries         56
## 12 Two or More Races      Reserved Idealists           68
## 13 White/Caucasian        Reactive Realists            85
## 14 White/Caucasian        Balanced Visionaries        337
## 15 White/Caucasian        Reserved Idealists          473

## 
##  Kruskal-Wallis rank sum test
## 
## data:  new_classdata$Class by new_classdata$SEX
## Kruskal-Wallis chi-squared = 4.3038, df = 1, p-value = 0.03803

#Research Question 3 ———- #To what extent do latent profiles of personality and imagination predict students’ college disciplines?

##                 Initiate  Conceive Transform     Extra         Open    EmotStab
## Initiate      1.00000000 0.6903814 0.6963251 0.3273444  0.394268374  0.14055876
## Conceive      0.69038141 1.0000000 0.7327789 0.2668825  0.275498182  0.21360802
## Transform     0.69632512 0.7327789 1.0000000 0.3262640  0.334789552  0.17918825
## Extra         0.32734436 0.2668825 0.3262640 1.0000000  0.109570733  0.38157448
## Open          0.39426837 0.2754982 0.3347896 0.1095707  1.000000000 -0.08158857
## EmotStab      0.14055876 0.2136080 0.1791882 0.3815745 -0.081588574  1.00000000
## Agree         0.07534592 0.1478853 0.1543839 0.1083288  0.152113714  0.29861969
## Conscientious 0.22766000 0.4017338 0.2614081 0.2527994  0.004034675  0.39176735
##                    Agree Conscientious
## Initiate      0.07534592   0.227659999
## Conceive      0.14788529   0.401733848
## Transform     0.15438389   0.261408070
## Extra         0.10832877   0.252799390
## Open          0.15211371   0.004034675
## EmotStab      0.29861969   0.391767354
## Agree         1.00000000   0.228523741
## Conscientious 0.22852374   1.000000000

##               vars    n mean   sd median trimmed  mad  min max range  skew
## Initiate         1 1560 4.41 0.82   4.44    4.43 0.82 1.56   6  4.44 -0.34
## Conceive         2 1560 4.47 0.74   4.44    4.48 0.66 1.33   6  4.67 -0.34
## Transform        3 1560 4.60 0.79   4.71    4.63 0.85 1.00   6  5.00 -0.46
## Extra            4 1560 3.11 0.87   3.10    3.12 1.04 1.00   5  4.00 -0.07
## Open             5 1560 3.99 0.63   4.10    4.04 0.59 1.10   5  3.90 -0.74
## EmotStab         6 1560 3.22 0.85   3.20    3.22 0.89 1.00   5  4.00 -0.07
## Agree            7 1560 3.84 0.58   3.90    3.87 0.59 1.50   5  3.50 -0.53
## Conscientious    8 1560 3.55 0.74   3.60    3.56 0.74 1.10   5  3.90 -0.22
##               kurtosis   se
## Initiate          0.14 0.02
## Conceive          0.39 0.02
## Transform         0.45 0.02
## Extra            -0.64 0.02
## Open              0.55 0.02
## EmotStab         -0.69 0.02
## Agree             0.16 0.01
## Conscientious    -0.29 0.02

library(apaTables)

# Example data with only numeric variables
numeric_vars <- new_classdata %>%
  dplyr::select(Initiate, Conceive, Transform, Extra, Open, EmotStab, Agree, Conscientious)

# APA correlation table
apa.cor.table(numeric_vars, table.number = 3, filename = "APA_Correlations.doc")

Table 3

Means, standard deviations, and correlations with confidence intervals

Variable M SD 1 2 3 4
1. Initiate 4.41 0.82

2. Conceive 4.47 0.74 .69**
   [.66, .72]

3. Transform 4.60 0.79 .70** .73**
   [.67, .72] [.71, .75]

4. Extra 3.11 0.87 .33** .27** .33**
   [.28, .37] [.22, .31] [.28, .37]

5. Open 3.99 0.63 .39** .28** .33** .11**
   [.35, .44] [.23, .32] [.29, .38] [.06, .16]

6. EmotStab 3.22 0.85 .14** .21** .18** .38**
   [.09, .19] [.17, .26] [.13, .23] [.34, .42]

7. Agree 3.84 0.58 .08** .15** .15** .11**
   [.03, .12] [.10, .20] [.11, .20] [.06, .16]

8. Conscientious 3.55 0.74 .23** .40** .26** .25**
   [.18, .27] [.36, .44] [.21, .31] [.21, .30]

5 6 7

-.08**
[-.13, -.03]

.15** .30**
[.10, .20] [.25, .34]

.00 .39** .23**
[-.05, .05] [.35, .43] [.18, .28]

Note. M and SD are used to represent mean and standard deviation, respectively. Values in square brackets indicate the 95% confidence interval. The confidence interval is a plausible range of population correlations that could have caused the sample correlation (Cumming, 2014). * indicates p < .05. ** indicates p < .01.

library(dplyr)
library(tidyr)
library(officer)

# Define profile and indicator variables
indicators <- c("Initiate", "Conceive", "Transform", 
                "Extra", "Open", "EmotStab", "Agree", "Conscientious")

table(new_classdata$Class)

## 
##    Reactive Realists Balanced Visionaries   Reserved Idealists 
##                  166                  562                  832

prop.table(table(new_classdata$Class))

## 
##    Reactive Realists Balanced Visionaries   Reserved Idealists 
##            0.1064103            0.3602564            0.5333333

# Reshape and summarize means and SDs
profile_summary <- new_classdata %>%
  pivot_longer(cols = all_of(indicators), names_to = "Variable", values_to = "Score") %>%
  group_by(Class, Variable) %>%
  summarise(
    Mean = round(mean(Score, na.rm = TRUE), 2),
    SD = round(sd(Score, na.rm = TRUE), 2),
    .groups = "drop"
  ) %>%
  mutate(Summary = paste0(Mean, " (", SD, ")")) %>%
  dplyr::select(Class, Variable, Summary) %>%
  pivot_wider(names_from = Class, values_from = Summary)


# Sex proportions
sex_props <- new_classdata %>%
  count(Class, SEX) %>%
  group_by(Class) %>%
  mutate(Prop = round(n / sum(n) * 100, 1)) %>%
  pivot_wider(names_from = Class, values_from = Prop) %>%
  mutate(Variable = SEX) %>%
  dplyr::select(Variable, everything(), -SEX)

# College proportions
college_props <- new_classdata %>%
  count(Class, COLLEGENAME) %>%
  group_by(Class) %>%
  mutate(Prop = round(n / sum(n) * 100, 2)) %>%
  pivot_wider(names_from = Class, values_from = Prop) %>%
  rename(Variable = COLLEGENAME)

# Tag sections
profile_summary$Category <- ifelse(profile_summary$Variable %in% c("Initiate", "Conceive", "Transform"), "Imagination Scale", "Big Five Personality")
sex_props$Category <- "Sex"
college_props$Category <- "College"

# Convert all columns (except 'Category' and 'Variable') to character
convert_all_to_char <- function(df) {
  df %>%
    mutate(across(-c(Category, Variable), as.character))
}

# Apply to each data frame
profile_summary <- convert_all_to_char(profile_summary)
profile_summary

## # A tibble: 8 × 5
##   Variable      `Reactive Realists` `Balanced Visionaries` `Reserved Idealists`
##   <chr>         <chr>               <chr>                  <chr>               
## 1 Agree         3.56 (0.59)         3.97 (0.57)            3.81 (0.56)         
## 2 Conceive      3.24 (0.55)         5.13 (0.45)            4.26 (0.43)         
## 3 Conscientious 2.95 (0.71)         3.9 (0.7)              3.43 (0.65)         
## 4 EmotStab      2.74 (0.81)         3.5 (0.85)             3.12 (0.79)         
## 5 Extra         2.47 (0.82)         3.51 (0.79)            2.97 (0.82)         
## 6 Initiate      3.16 (0.66)         5.14 (0.51)            4.16 (0.53)         
## 7 Open          3.45 (0.66)         4.24 (0.53)            3.93 (0.6)          
## 8 Transform     3.34 (0.66)         5.31 (0.46)            4.38 (0.49)         
## # ℹ 1 more variable: Category <chr>

sex_props <- convert_all_to_char(sex_props)
sex_props

## # A tibble: 6 × 6
##   Variable n     `Reactive Realists` `Balanced Visionaries` `Reserved Idealists`
##   <fct>    <chr> <chr>               <chr>                  <chr>               
## 1 Female   108   65.1                <NA>                   <NA>                
## 2 Male     58    34.9                <NA>                   <NA>                
## 3 Female   350   <NA>                62.3                   <NA>                
## 4 Male     212   <NA>                37.7                   <NA>                
## 5 Female   570   <NA>                <NA>                   68.5                
## 6 Male     262   <NA>                <NA>                   31.5                
## # ℹ 1 more variable: Category <chr>

college_props <- convert_all_to_char(college_props)
college_props

## # A tibble: 27 × 6
##    Variable                     n     `Reactive Realists` `Balanced Visionaries`
##    <fct>                        <chr> <chr>               <chr>                 
##  1 Business                     21    12.65               <NA>                  
##  2 Education                    17    10.24               <NA>                  
##  3 Engineering                  23    13.86               <NA>                  
##  4 Health and Public Service    18    10.84               <NA>                  
##  5 Journalism                   2     1.2                 <NA>                  
##  6 Liberal Arts and Social Sci… 52    31.33               <NA>                  
##  7 Music                        4     2.41                <NA>                  
##  8 Science                      23    13.86               <NA>                  
##  9 Visual Arts and Design       6     3.61                <NA>                  
## 10 Business                     62    <NA>                11.03                 
## # ℹ 17 more rows
## # ℹ 2 more variables: `Reserved Idealists` <chr>, Category <chr>

# Now bind and arrange
final_table <- bind_rows(profile_summary, sex_props, college_props) %>%
  dplyr::select(Category, Variable, everything()) %>%
  arrange(factor(Category, levels = c("Imagination Scale", "Big Five Personality", "Sex", "College")))

# Create individual flextables
ft_profile <- flextable(profile_summary) %>%
  autofit() %>%
  set_caption("Table 4. Means and Standard Deviations of Imagination and Personality Traits by Latent Profile")

ft_sex <- flextable(sex_props) %>%
  autofit() %>%
  set_caption("Table 5. Proportion of Sex by Latent Profile")

ft_college <- flextable(college_props) %>%
  autofit() %>%
  set_caption("Table 6. Proportion of College Discipline by Latent Profile")


library(flextable)

ft_final = flextable(final_table) %>%
  add_header_lines("Table X\nLatent Profile Summaries") %>%
  merge_v(j = ~ Category) %>%
  bold(j = 1, part = "body") %>%
  italic(j = 1, part = "body") %>%
  autofit() %>%
  set_caption("Latent Profile Summaries by Class Membership") %>%
  theme_booktabs()

# Combine into a Word document
doc <- read_docx() %>%
  body_add_par("Latent Profile Tables", style = "heading 1") %>%
  body_add_flextable(ft_profile) %>%
  body_add_par("", style = "Normal") %>%
  body_add_flextable(ft_sex) %>%
  body_add_par("", style = "Normal") %>%
  body_add_flextable(ft_college) %>%
  body_add_par("", style = "Normal") %>%
  body_add_flextable(ft_final)

# Save the Word file
print(doc, target = "Latent_Profile_Tables.docx")

#Covariate analyses - Chi Square

# Contingency table
table_Sex_Chi <- table(new_classdata$Class, filtered_df$SEX)
print(table_Sex_Chi)

##                       
##                        Female Male
##   Reactive Realists       108   58
##   Balanced Visionaries    350  212
##   Reserved Idealists      570  262

# Calculate effect size (Cramér's V)
library(rcompanion)
cramerV(table_Sex_Chi, ci = TRUE, rep = 1000)

##   Cramer.V lower.ci upper.ci
## 1  0.06126  0.02052   0.1222

# Chi-square test
sex_chi_result = chisq.test(table_Sex_Chi)
print(sex_chi_result)

## 
##  Pearson's Chi-squared test
## 
## data:  table_Sex_Chi
## X-squared = 5.8549, df = 2, p-value = 0.05353

# Cohen's w
chi_sq <- sex_chi_result$statistic
n_total <- sum(table_Sex_Chi)
cohen_w <- sqrt(chi_sq / n_total)

print(cohen_w)

##  X-squared 
## 0.06126293

# Make sure COLLEGENAME is a factor with that order
tbl3 <- with(classdata, table(Class, SEX))
tbl3_df <- as.data.frame(tbl3)
tbl3_df$SEX <- factor(tbl3_df$SEX)

tbl3 <- with(new_classdata, table(Class, SEX))
ggplot(tbl3_df, aes(factor(SEX), Freq, fill = Class)) +     
  geom_col(position = 'dodge') + labs(title = "Covariate Analysis: Profiles by Sex", y = "Frequency", x = "SEX") + 
  scale_fill_manual(name = "Profiles", , labels = c("Reactive Realists", "Balanced Visionaries","Reserved Idealists"), values=c("darkgray", "blue", "black")) +
  geom_text(aes(label = Freq), position = position_dodge(.9), size = 5, colour = "black",vjust = .005) +
  theme_bw() + theme(text=element_text(size=12,  family="serif"), title = element_text(face = "bold.italic", color = "black",size = 12), axis.title = element_text(face = "bold", color = "black",size = 14),
                     legend.position="bottom", legend.text = element_text(size = 12),legend.title = element_text(size = 14), axis.text = element_text(face = "bold", color = "black",size = 10), ,axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)) 

# Contingency table
table_Age_Chi <- table(new_classdata$Class, filtered_df$AGE)
print(table_Age_Chi)

##                       
##                         18  19  20  21  22  23  24  25  26  27  28  29  30  31
##   Reactive Realists      1  19  30  30  28  17  12   3   7   6   1   0   1   0
##   Balanced Visionaries   1  63  74  72  55  45  43  23  18  11  15  11  14  16
##   Reserved Idealists     3 103 169 126 130  61  35  32  25  18  23  12  15   5
##                       
##                         32  33  34  35  36  37  38  39  40  41  42  43  44  45
##   Reactive Realists      3   0   0   0   2   0   0   1   0   1   1   0   0   0
##   Balanced Visionaries  13   7   4   5   5   4   4   2   2   1   3   3   5   3
##   Reserved Idealists    10   9   7   5   6   3   7   3   1   3   2   1   2   0
##                       
##                         46  47  48  49
##   Reactive Realists      1   1   0   1
##   Balanced Visionaries   1   6   3  30
##   Reserved Idealists     3   1   1  11

# Chi-square test
chisq.test(table_Age_Chi)

## 
##  Pearson's Chi-squared test
## 
## data:  table_Age_Chi
## X-squared = 119.41, df = 62, p-value = 1.65e-05

# Calculate effect size (Cramér's V)
library(rcompanion)
cramerV(table_Age_Chi, ci = TRUE, rep = 1000)

##   Cramer.V lower.ci upper.ci
## 1   0.1956   0.2034   0.2604

# Contingency table
table_Honors_Chi <- table(new_classdata$Class, new_classdata$UNTHONOR)
print(table_Honors_Chi)

##                       
##                        Honors College Not Honors College
##   Reactive Realists                12                154
##   Balanced Visionaries             59                503
##   Reserved Idealists              100                732

# Chi-square test
chisq.test(table_Honors_Chi)

## 
##  Pearson's Chi-squared test
## 
## data:  table_Honors_Chi
## X-squared = 3.4469, df = 2, p-value = 0.1784

# Calculate effect size (Cramér's V)
library(rcompanion)
cramerV(table_Honors_Chi, ci = TRUE, rep = 1000)

##   Cramer.V lower.ci upper.ci
## 1  0.04701  0.01261    0.093

# Chi-square test
honors_chi_result = chisq.test(table_Honors_Chi)
print(honors_chi_result)

## 
##  Pearson's Chi-squared test
## 
## data:  table_Honors_Chi
## X-squared = 3.4469, df = 2, p-value = 0.1784

# Contingency table
table_Race_Chi <- table(new_classdata$Class, filtered_df$RACE)
print(table_Race_Chi)

##                       
##                        Asian Black/African American Hispanic/Latinx
##   Reactive Realists       17                     12              38
##   Balanced Visionaries    35                     45              89
##   Reserved Idealists      90                     46             155
##                       
##                        Two or More Races White/Caucasian
##   Reactive Realists                   14              85
##   Balanced Visionaries                56             337
##   Reserved Idealists                  68             473

# Chi-square test
chisq.test(table_Race_Chi)

## 
##  Pearson's Chi-squared test
## 
## data:  table_Race_Chi
## X-squared = 18.138, df = 8, p-value = 0.02022

# Calculate effect size (Cramér's V)
library(rcompanion)
cramerV(table_Race_Chi, ci = TRUE, rep = 1000)

##   Cramer.V lower.ci upper.ci
## 1  0.07625  0.06064   0.1214

# Make sure COLLEGENAME is a factor with that order
tbl2 <- with(classdata, table(Class, RACE))
tbl2_df <- as.data.frame(tbl2)
tbl2_df$COLLEGENAME <- factor(tbl2_df$RACE)

tbl2 <- with(new_classdata, table(Class, RACE))
ggplot(tbl2_df, aes(factor(RACE), Freq, fill = Class)) +     
  geom_col(position = 'dodge') + labs(title = "Covariate Analysis: Profiles by Race", y = "Frequency", x = "RACE") + 
  scale_fill_manual(name = "Profiles", , labels = c("Reactive Realists", "Balanced Visionaries","Reserved Idealists"), values=c("darkgray", "blue", "black")) +
  geom_text(aes(label = Freq), position = position_dodge(.9), size = 5, colour = "black",vjust = .005) +
  theme_bw() + theme(text=element_text(size=12,  family="serif"), title = element_text(face = "bold.italic", color = "black",size = 12), axis.title = element_text(face = "bold", color = "black",size = 14),
                     legend.position="bottom", legend.text = element_text(size = 12),legend.title = element_text(size = 14), axis.text = element_text(face = "bold", color = "black",size = 10), ,axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)) 

# Contingency table
table_College_Chi <- table(new_classdata$Class, filtered_df$COLLEGENAME)
print(table_College_Chi)

##                       
##                        Business Education Engineering Health and Public Service
##   Reactive Realists          21        17          23                        18
##   Balanced Visionaries       62        88          50                        54
##   Reserved Idealists         78       123          79                        63
##                       
##                        Journalism Liberal Arts and Social Sciences Music
##   Reactive Realists             2                               52     4
##   Balanced Visionaries         18                              177    26
##   Reserved Idealists           22                              241    43
##                       
##                        Science Visual Arts and Design
##   Reactive Realists         23                      6
##   Balanced Visionaries      50                     37
##   Reserved Idealists       137                     46

# Chi-square test
chisq.test(table_College_Chi)

## 
##  Pearson's Chi-squared test
## 
## data:  table_College_Chi
## X-squared = 31.808, df = 16, p-value = 0.01059

# Calculate effect size (Cramér's V)
library(rcompanion)
cramerV(table_College_Chi, ci = TRUE, rep = 1000)

##   Cramer.V lower.ci upper.ci
## 1    0.101  0.09068   0.1521

# Grouped
library(scalesextra)
# Your preferred order of colleges on the x-axis:
college_order <- sort(c(
  "Engineering", 
  "Business", 
  "Education", 
  "Health and Public Service", 
  "Science", 
  "Liberal Arts and Social Sciences",
  "Visual Arts and Design", 
  "Music", 
  "Journalism"
))

# Make sure COLLEGENAME is a factor with that order
tbl1 <- with(classdata, table(Class, COLLEGENAME))
tbl1_df <- as.data.frame(tbl1)
tbl1_df$COLLEGENAME <- factor(tbl1_df$COLLEGENAME, levels = college_order)

tbl1 <- with(new_classdata, table(Class, COLLEGENAME))
ggplot(tbl1_df, aes(factor(COLLEGENAME), Freq, fill = Class)) +     
  geom_col(position = 'dodge') + labs(title = "Covariate Analysis: Profiles by College Discipline", y = "Frequency", x = "College Membership") + 
  scale_fill_manual(name = "Profiles", , labels = c("Reactive Realists", "Balanced Visionaries","Reserved Idealists"), values=c("darkgray", "blue", "black")) +
  geom_text(aes(label = Freq), position = position_dodge(.9), size = 5, colour = "black",vjust = .005) +
  theme_bw() + theme(text=element_text(size=12,  family="serif"), title = element_text(face = "bold.italic", color = "black",size = 12), axis.title = element_text(face = "bold", color = "black",size = 14),
                     legend.position="bottom", legend.text = element_text(size = 12),legend.title = element_text(size = 14), axis.text = element_text(face = "bold", color = "black",size = 10), ,axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1)) 

#Multinomial Regression #Block 1 - Profile to College Discipline

#Null model

# Null model (intercept only)
m0 <- multinom(COLLEGENAME ~ 1, data = new_classdata)

## # weights:  18 (8 variable)
## initial  value 3427.670341 
## iter  10 value 3157.888631
## final  value 3103.618029 
## converged

summary(m0)

## Call:
## multinom(formula = COLLEGENAME ~ 1, data = new_classdata)
## 
## Coefficients:
##                                  (Intercept)
## Education                         0.34788182
## Engineering                      -0.05757084
## Health and Public Service        -0.17618512
## Journalism                       -1.34382496
## Liberal Arts and Social Sciences  1.07133086
## Music                            -0.79097083
## Science                           0.26565104
## Visual Arts and Design           -0.59280021
## 
## Std. Errors:
##                                  (Intercept)
## Education                         0.10294217
## Engineering                       0.11309313
## Health and Public Service         0.11669873
## Journalism                        0.17326845
## Liberal Arts and Social Sciences  0.09131586
## Music                             0.14110128
## Science                           0.10475212
## Visual Arts and Design            0.13208701
## 
## Residual Deviance: 6207.236 
## AIC: 6223.236

AIC(m0)

## [1] 6223.236

new_classdata$SEX <- relevel(new_classdata$SEX, ref = "Male")
new_classdata$Class <- relevel(new_classdata$Class, ref = "Reserved Idealists")
new_classdata$RACE <- relevel(new_classdata$RACE, ref = "White/Caucasian")
new_classdata$COLLEGENAME <- as.factor(new_classdata$COLLEGENAME)
new_classdata$COLLEGENAME <- relevel(new_classdata$COLLEGENAME, ref="Liberal Arts and Social Sciences")

m1 <- multinom(COLLEGENAME ~ Class, data = new_classdata, model = TRUE)

## # weights:  36 (24 variable)
## initial  value 3427.670341 
## iter  10 value 3094.855004
## iter  20 value 3087.330382
## iter  30 value 3086.950498
## iter  30 value 3086.950479
## iter  30 value 3086.950479
## final  value 3086.950479 
## converged

summary(m1)

## Call:
## multinom(formula = COLLEGENAME ~ Class, data = new_classdata, 
##     model = TRUE)
## 
## Coefficients:
##                           (Intercept) ClassReactive Realists
## Business                   -1.1279932              0.2211105
## Education                  -0.6725144             -0.4456452
## Engineering                -1.1153330              0.2996748
## Health and Public Service  -1.3416124              0.2807186
## Journalism                 -2.3935742             -0.8655324
## Music                      -1.7235681             -0.8416016
## Science                    -0.5647575             -0.2509953
## Visual Arts and Design     -1.6560524             -0.5034851
##                           ClassBalanced Visionaries
## Business                                 0.07893612
## Education                               -0.02631427
## Engineering                             -0.14878940
## Health and Public Service                0.15439807
## Journalism                               0.10779356
## Music                                   -0.19445215
## Science                                 -0.69938839
## Visual Arts and Design                   0.09072636
## 
## Std. Errors:
##                           (Intercept) ClassReactive Realists
## Business                    0.1302671              0.2895240
## Education                   0.1108119              0.3005625
## Engineering                 0.1296466              0.2819762
## Health and Public Service   0.1415013              0.3079073
## Journalism                  0.2227066              0.7545276
## Music                       0.1655473              0.5446835
## Science                     0.1069990              0.2723146
## Visual Arts and Design      0.1608961              0.4602020
##                           ClassBalanced Visionaries
## Business                                  0.1968465
## Education                                 0.1711505
## Engineering                               0.2060520
## Health and Public Service                 0.2102173
## Journalism                                0.3328702
## Music                                     0.2674231
## Science                                   0.1926096
## Visual Arts and Design                    0.2420047
## 
## Residual Deviance: 6173.901 
## AIC: 6221.901

#zscores

z1 <- summary(m1)$coefficients/summary(m1)$standard.errors
z1

##                           (Intercept) ClassReactive Realists
## Business                    -8.659077              0.7637036
## Education                   -6.068973             -1.4827040
## Engineering                 -8.602869              1.0627662
## Health and Public Service   -9.481275              0.9116983
## Journalism                 -10.747658             -1.1471184
## Music                      -10.411334             -1.5451204
## Science                     -5.278154             -0.9217108
## Visual Arts and Design     -10.292679             -1.0940526
##                           ClassBalanced Visionaries
## Business                                  0.4010033
## Education                                -0.1537492
## Engineering                              -0.7220964
## Health and Public Service                 0.7344689
## Journalism                                0.3238306
## Music                                    -0.7271330
## Science                                  -3.6311200
## Visual Arts and Design                    0.3748950

#pvalues

p1 <- (1 - pnorm(abs(z1), 0, 1)) * 2
p1

##                            (Intercept) ClassReactive Realists
## Business                  0.000000e+00              0.4450439
## Education                 1.287311e-09              0.1381531
## Engineering               0.000000e+00              0.2878880
## Health and Public Service 0.000000e+00              0.3619276
## Journalism                0.000000e+00              0.2513327
## Music                     0.000000e+00              0.1223171
## Science                   1.304918e-07              0.3566795
## Visual Arts and Design    0.000000e+00              0.2739319
##                           ClassBalanced Visionaries
## Business                               0.6884176777
## Education                              0.8778074595
## Engineering                            0.4702351847
## Health and Public Service              0.4626630267
## Journalism                             0.7460662580
## Music                                  0.4671444677
## Science                                0.0002821939
## Visual Arts and Design                 0.7077385270

#odds ratios, confidence intervels, effect size

exp(coef(m1))  # Odds ratios

##                           (Intercept) ClassReactive Realists
## Business                   0.32368216              1.2474613
## Education                  0.51042354              0.6404109
## Engineering                0.32780611              1.3494199
## Health and Public Service  0.26142380              1.3240809
## Journalism                 0.09130277              0.4208274
## Music                      0.17842837              0.4310197
## Science                    0.56849802              0.7780260
## Visual Arts and Design     0.19089106              0.6044205
##                           ClassBalanced Visionaries
## Business                                  1.0821352
## Education                                 0.9740289
## Engineering                               0.8617506
## Health and Public Service                 1.1669553
## Journalism                                1.1138178
## Music                                     0.8232856
## Science                                   0.4968891
## Visual Arts and Design                    1.0949693

confint(m1) 

## , , Business
## 
##                                2.5 %     97.5 %
## (Intercept)               -1.3833121 -0.8726743
## ClassReactive Realists    -0.3463461  0.7885671
## ClassBalanced Visionaries -0.3068760  0.4647483
## 
## , , Education
## 
##                                2.5 %     97.5 %
## (Intercept)               -0.8897018 -0.4553271
## ClassReactive Realists    -1.0347369  0.1434464
## ClassBalanced Visionaries -0.3617632  0.3091346
## 
## , , Engineering
## 
##                                2.5 %     97.5 %
## (Intercept)               -1.3694357 -0.8612302
## ClassReactive Realists    -0.2529885  0.8523381
## ClassBalanced Visionaries -0.5526439  0.2550651
## 
## , , Health and Public Service
## 
##                                2.5 %     97.5 %
## (Intercept)               -1.6189498 -1.0642750
## ClassReactive Realists    -0.3227687  0.8842058
## ClassBalanced Visionaries -0.2576203  0.5664164
## 
## , , Journalism
## 
##                               2.5 %     97.5 %
## (Intercept)               -2.830071 -1.9570773
## ClassReactive Realists    -2.344379  0.6133144
## ClassBalanced Visionaries -0.544620  0.7602071
## 
## , , Music
## 
##                                2.5 %     97.5 %
## (Intercept)               -2.0480348 -1.3991014
## ClassReactive Realists    -1.9091616  0.2259584
## ClassBalanced Visionaries -0.7185918  0.3296875
## 
## , , Science
## 
##                                2.5 %     97.5 %
## (Intercept)               -0.7744717 -0.3550432
## ClassReactive Realists    -0.7847222  0.2827315
## ClassBalanced Visionaries -1.0768962 -0.3218806
## 
## , , Visual Arts and Design
## 
##                                2.5 %     97.5 %
## (Intercept)               -1.9714030 -1.3407017
## ClassReactive Realists    -1.4054644  0.3984941
## ClassBalanced Visionaries -0.3835941  0.5650469

DescTools::PseudoR2(m1, which = c("Nagelkerke", "McFadden"))

##  Nagelkerke    McFadden 
## 0.021544945 0.005370361

AIC(m1)

## [1] 6221.901

# Likelihood Ratio Chi-square test
lr_chi <- 2 * (logLik(m1) - logLik(m0))
lr_chi  # Chi-square value

## 'log Lik.' 33.3351 (df=24)

# Degrees of freedom (difference in number of parameters)
df <- attr(logLik(m1), "df") - attr(logLik(m0), "df")
df

## [1] 16

# p-value
p_val <- pchisq(lr_chi, df = df, lower.tail = FALSE)

# Show real results
cat("Chi-square =", round(lr_chi, 2), "\n")

## Chi-square = 33.34

cat("df =", df, "\n")

## df = 16

cat("p-value =", format.pval(p_val, digits = 4), "\n")

## p-value = 0.00667

library(nnet)
library(dplyr)
library(tidyr)
library(flextable)
library(officer)

# Fit model
m1 <- multinom(COLLEGENAME ~ Class, data = new_classdata, model = TRUE)

## # weights:  36 (24 variable)
## initial  value 3427.670341 
## iter  10 value 3094.855004
## iter  20 value 3087.330382
## iter  30 value 3086.950498
## iter  30 value 3086.950479
## iter  30 value 3086.950479
## final  value 3086.950479 
## converged

# Extract components
coefs <- summary(m1)$coefficients
ses <- summary(m1)$standard.errors
z <- coefs / ses
p <- (1 - pnorm(abs(z))) * 2
or <- exp(coefs)

# Outcome and predictor labels
outcome_labels <- rownames(coefs)
predictor_labels <- colnames(coefs)

# Build long-format table manually with CI calculation
results_list <- list()
for (i in seq_along(outcome_labels)) {
  for (j in seq_along(predictor_labels)) {
    b <- coefs[i, j]
    se <- ses[i, j]
    or_val <- or[i, j]
    
    # 95% CI for OR using log(OR) ± 1.96 * SE, then exponentiate
    ci_low <- exp(b - 1.96 * se)
    ci_high <- exp(b + 1.96 * se)

    results_list[[length(results_list) + 1]] <- data.frame(
      outcome = outcome_labels[i],
      predictor = predictor_labels[j],
      B = round(b, 2),
      SE = round(se, 2),
      OR = round(or_val, 2),
      CI = paste0("[", round(ci_low, 2), ", ", round(ci_high, 2), "]"),
      p = ifelse(p[i, j] < .001, "< .001", formatC(p[i, j], digits = 3, format = "f"))
    )
  }
}
results_long <- do.call(rbind, results_list)

# Pivot to wide format
results_wide <- results_long %>%
  pivot_wider(
    names_from = predictor,
    values_from = c(B, SE, OR, CI, p),
    names_glue = "{predictor}_{.value}"
  ) %>%
  rename(`Outcome Category` = outcome)

# Create APA-style table
ft <- flextable(results_wide) %>%
  theme_booktabs() %>%
  autofit() %>%
  add_footer_lines("Note. B = log-odds; OR = odds ratio; CI = 95% confidence interval. Reference outcome = Liberal Arts and Social Sciences. Reference profile = Reserved Idealists.")

# Save to Word
save_as_docx(
  "Multinomial Logistic Regression – Model 1" = ft,
  path = "Model1_Multinomial_Wide.docx"
)

#Block 2 - Adding Sex to the model

## # weights:  45 (32 variable)
## initial  value 3427.670341 
## iter  10 value 3067.042640
## iter  20 value 3013.560583
## iter  30 value 3010.455202
## final  value 3010.403190 
## converged

## Call:
## multinom(formula = COLLEGENAME ~ Class + SEX, data = new_classdata, 
##     model = TRUE)
## 
## Coefficients:
##                           (Intercept) ClassReactive Realists
## Business                   -0.6261838              0.2123548
## Education                  -1.0992065             -0.4406413
## Engineering                -0.2181427              0.2797141
## Health and Public Service  -1.4853565              0.2826601
## Journalism                 -2.5601431             -0.8617982
## Music                      -1.1803095             -0.8511467
## Science                    -0.6500027             -0.2498042
## Visual Arts and Design     -2.2091125             -0.4974272
##                           ClassBalanced Visionaries  SEXFemale
## Business                                0.019898944 -0.7904183
## Education                               0.006770923  0.5519538
## Engineering                            -0.276118245 -1.7149735
## Health and Public Service               0.167064695  0.1938944
## Journalism                              0.122384523  0.2235615
## Music                                  -0.259760435 -0.8683873
## Science                                -0.691662318  0.1160910
## Visual Arts and Design                  0.131424988  0.7042239
## 
## Std. Errors:
##                           (Intercept) ClassReactive Realists
## Business                    0.1722563              0.2916145
## Education                   0.1895408              0.3011476
## Engineering                 0.1611376              0.2923134
## Health and Public Service   0.2174427              0.3080013
## Journalism                  0.3568730              0.7541529
## Music                       0.2191052              0.5460065
## Science                     0.1739673              0.2723619
## Visual Arts and Design      0.2920293              0.4607831
##                           ClassBalanced Visionaries SEXFemale
## Business                                  0.1986774 0.1873804
## Education                                 0.1719807 0.1936080
## Engineering                               0.2123389 0.2048873
## Health and Public Service                 0.2107382 0.2195121
## Journalism                                0.3337129 0.3660552
## Music                                     0.2693958 0.2557041
## Science                                   0.1929984 0.1859150
## Visual Arts and Design                    0.2429738 0.2943841
## 
## Residual Deviance: 6020.806 
## AIC: 6084.806

## [1] 6084.806

#zscores

##                           (Intercept) ClassReactive Realists
## Business                    -3.635187              0.7282038
## Education                   -5.799314             -1.4632069
## Engineering                 -1.353767              0.9568980
## Health and Public Service   -6.831026              0.9177238
## Journalism                  -7.173820             -1.1427367
## Music                       -5.386953             -1.5588581
## Science                     -3.736351             -0.9171776
## Visual Arts and Design      -7.564695             -1.0795257
##                           ClassBalanced Visionaries  SEXFemale
## Business                                 0.10015705 -4.2182548
## Education                                0.03937026  2.8508834
## Engineering                             -1.30036603 -8.3703242
## Health and Public Service                0.79275943  0.8832967
## Journalism                               0.36673599  0.6107317
## Music                                   -0.96423346 -3.3960627
## Science                                 -3.58377231  0.6244308
## Visual Arts and Design                   0.54090180  2.3921944

#pvalues

##                            (Intercept) ClassReactive Realists
## Business                  2.777793e-04              0.4664888
## Education                 6.658679e-09              0.1434108
## Engineering               1.758107e-01              0.3386188
## Health and Public Service 8.431034e-12              0.3587635
## Journalism                7.294165e-13              0.2531479
## Music                     7.166224e-08              0.1190300
## Science                   1.867103e-04              0.3590496
## Visual Arts and Design    3.885781e-14              0.2803534
##                           ClassBalanced Visionaries    SEXFemale
## Business                               0.9202196418 2.462005e-05
## Education                              0.9685951933 4.359795e-03
## Engineering                            0.1934755475 0.000000e+00
## Health and Public Service              0.4279179998 3.770760e-01
## Journalism                             0.7138159555 5.413772e-01
## Music                                  0.3349288949 6.836269e-04
## Science                                0.0003386673 5.323447e-01
## Visual Arts and Design                 0.5885752701 1.674797e-02

#odds ratios, confidence intervels, effect size

##                           (Intercept) ClassReactive Realists
## Business                   0.53462814              1.2365865
## Education                  0.33313532              0.6436235
## Engineering                0.80401067              1.3227515
## Health and Public Service  0.22642161              1.3266542
## Journalism                 0.07729368              0.4224018
## Music                      0.30718364              0.4269251
## Science                    0.52204436              0.7789532
## Visual Arts and Design     0.10979805              0.6080931
##                           ClassBalanced Visionaries SEXFemale
## Business                                  1.0200982 0.4536550
## Education                                 1.0067939 1.7366428
## Engineering                               0.7587232 0.1799685
## Health and Public Service                 1.1818307 1.2139680
## Journalism                                1.1301886 1.2505226
## Music                                     0.7712363 0.4196278
## Science                                   0.5007430 1.1230981
## Visual Arts and Design                    1.1404524 2.0222765

## , , Business
## 
##                                2.5 %     97.5 %
## (Intercept)               -0.9638000 -0.2885677
## ClassReactive Realists    -0.3591991  0.7839086
## ClassBalanced Visionaries -0.3695016  0.4092995
## SEXFemale                 -1.1576772 -0.4231595
## 
## , , Education
## 
##                                2.5 %     97.5 %
## (Intercept)               -1.4706996 -0.7277134
## ClassReactive Realists    -1.0308798  0.1495972
## ClassBalanced Visionaries -0.3303050  0.3438469
## SEXFemale                  0.1724891  0.9314185
## 
## , , Engineering
## 
##                                2.5 %     97.5 %
## (Intercept)               -0.5339666  0.0976811
## ClassReactive Realists    -0.2932096  0.8526378
## ClassBalanced Visionaries -0.6922948  0.1400583
## SEXFemale                 -2.1165453 -1.3134017
## 
## , , Health and Public Service
## 
##                                2.5 %     97.5 %
## (Intercept)               -1.9115363 -1.0591767
## ClassReactive Realists    -0.3210113  0.8863316
## ClassBalanced Visionaries -0.2459746  0.5801040
## SEXFemale                 -0.2363415  0.6241302
## 
## , , Journalism
## 
##                                2.5 %     97.5 %
## (Intercept)               -3.2596014 -1.8606848
## ClassReactive Realists    -2.3399108  0.6163144
## ClassBalanced Visionaries -0.5316807  0.7764497
## SEXFemale                 -0.4938936  0.9410166
## 
## , , Music
## 
##                                2.5 %     97.5 %
## (Intercept)               -1.6097479 -0.7508712
## ClassReactive Realists    -1.9212999  0.2190065
## ClassBalanced Visionaries -0.7877665  0.2682456
## SEXFemale                 -1.3695581 -0.3672164
## 
## , , Science
## 
##                                2.5 %     97.5 %
## (Intercept)               -0.9909723 -0.3090331
## ClassReactive Realists    -0.7836238  0.2840153
## ClassBalanced Visionaries -1.0699322 -0.3133924
## SEXFemale                 -0.2482956  0.4804776
## 
## , , Visual Arts and Design
## 
##                                2.5 %     97.5 %
## (Intercept)               -2.7814794 -1.6367456
## ClassReactive Realists    -1.4005456  0.4056911
## ClassBalanced Visionaries -0.3447950  0.6076450
## SEXFemale                  0.1272417  1.2812060

## Nagelkerke   McFadden 
## 0.11478854 0.03003425

# Extract log-likelihoods
LL_m1 <- as.numeric(logLik(m1))
LL_m2 <- as.numeric(logLik(m2))

# Chi-square test for model comparison
lr_chi <- 2 * (LL_m2 - LL_m1)

# Degrees of freedom = difference in number of estimated parameters
df <- attr(logLik(m2), "df") - attr(logLik(m1), "df")

# p-value
p_val <- pchisq(lr_chi, df = df, lower.tail = FALSE)

# Print results
cat("Chi-square:", round(lr_chi, 2), "\n")

## Chi-square: 153.09

cat("df:", df, "\n")

## df: 8

cat("p-value:", round(p_val, 4), "\n")

## p-value: 0

library(nnet)
library(dplyr)
library(tidyr)
library(flextable)
library(officer)

# Fit model
m2 <- multinom(COLLEGENAME ~ Class + SEX, data = new_classdata, model = TRUE)

## # weights:  45 (32 variable)
## initial  value 3427.670341 
## iter  10 value 3067.042640
## iter  20 value 3013.560583
## iter  30 value 3010.455202
## final  value 3010.403190 
## converged

# Extract components
coefs <- summary(m2)$coefficients
ses <- summary(m2)$standard.errors
z <- coefs / ses
p <- (1 - pnorm(abs(z))) * 2
or <- exp(coefs)

# Outcome and predictor labels
outcome_labels <- rownames(coefs)
predictor_labels <- colnames(coefs)

# Build long-format table manually with CI calculation
results_list <- list()
for (i in seq_along(outcome_labels)) {
  for (j in seq_along(predictor_labels)) {
    b <- coefs[i, j]
    se <- ses[i, j]
    or_val <- or[i, j]
    
    # 95% CI for OR using log(OR) ± 1.96 * SE, then exponentiate
    ci_low <- exp(b - 1.96 * se)
    ci_high <- exp(b + 1.96 * se)

    results_list[[length(results_list) + 1]] <- data.frame(
      outcome = outcome_labels[i],
      predictor = predictor_labels[j],
      B = round(b, 2),
      SE = round(se, 2),
      OR = round(or_val, 2),
      CI = paste0("[", round(ci_low, 2), ", ", round(ci_high, 2), "]"),
      p = ifelse(p[i, j] < .001, "< .001", formatC(p[i, j], digits = 3, format = "f"))
    )
  }
}
results_long <- do.call(rbind, results_list)

# Pivot to wide format
results_wide <- results_long %>%
  pivot_wider(
    names_from = predictor,
    values_from = c(B, SE, OR, CI, p),
    names_glue = "{predictor}_{.value}"
  ) %>%
  rename(`Outcome Category` =outcome)

# Create APA-style table
ft <- flextable(results_wide) %>%
  theme_booktabs() %>%
  autofit() %>%
  add_footer_lines("Note. B = log-odds; OR = odds ratio; CI = 95% confidence interval. Reference outcome = Liberal Arts and Social Sciences. Reference profile = Reserved Idealists.")

# Save to Word
save_as_docx(
  "Multinomial Logistic Regression – Model 2" = ft,
  path = "Model2_Multinomial_Wide.docx"
)

#What is the relationship of sex and class to college discipline.
m3 <- multinom(COLLEGENAME ~ SEX * Class, data = new_classdata)

## # weights:  63 (48 variable)
## initial  value 3427.670341 
## iter  10 value 3075.282130
## iter  20 value 3003.947784
## iter  30 value 2996.684337
## iter  40 value 2996.263805
## final  value 2996.262801 
## converged

summary(m3)

## Call:
## multinom(formula = COLLEGENAME ~ SEX * Class, data = new_classdata)
## 
## Coefficients:
##                           (Intercept)   SEXFemale ClassReactive Realists
## Business                   -0.3975607 -1.22336989            -0.23150575
## Education                  -1.1142409  0.56302628             0.01580680
## Engineering                -0.2669733 -1.50812937             0.60325501
## Health and Public Service  -1.6737902  0.42932095            -0.34108957
## Journalism                 -2.7724180  0.48667512             0.06314986
## Music                      -0.9808595 -1.25074179            -1.03476375
## Science                    -0.4957112 -0.09544003            -1.11433256
## Visual Arts and Design     -2.3670801  0.87975446            -0.34150173
##                           ClassBalanced Visionaries
## Business                                -0.42926470
## Education                               -0.04912854
## Engineering                             -0.28116772
## Health and Public Service                0.60570600
## Journalism                               0.40497467
## Music                                   -0.78004921
## Science                                 -0.95434808
## Visual Arts and Design                   0.40517420
##                           SEXFemale:ClassReactive Realists
## Business                                         0.8066686
## Education                                       -0.5906425
## Engineering                                     -1.7454026
## Health and Public Service                        0.7472825
## Journalism                                      -1.3874481
## Music                                            0.3486130
## Science                                          1.0904568
## Visual Arts and Design                          -0.1724818
##                           SEXFemale:ClassBalanced Visionaries
## Business                                           0.84937960
## Education                                          0.09254949
## Engineering                                       -0.10593223
## Health and Public Service                         -0.62281216
## Journalism                                        -0.36130993
## Music                                              0.99236148
## Science                                            0.37330013
## Visual Arts and Design                            -0.31290314
## 
## Std. Errors:
##                           (Intercept) SEXFemale ClassReactive Realists
## Business                    0.1971748 0.2703733              0.4801698
## Education                   0.2514721 0.2805205              0.5742955
## Engineering                 0.1898190 0.2738945              0.3876892
## Health and Public Service   0.3145514 0.3524234              0.8157714
## Journalism                  0.5153462 0.5716496              1.1546649
## Music                       0.2393591 0.3399509              0.7900665
## Science                     0.2031648 0.2390166              0.6643772
## Visual Arts and Design      0.4269473 0.4614479              1.1177059
##                           ClassBalanced Visionaries
## Business                                  0.3003656
## Education                                 0.3589853
## Engineering                               0.2805096
## Health and Public Service                 0.4000372
## Journalism                                0.6692655
## Music                                     0.4047390
## Science                                   0.3514419
## Visual Arts and Design                    0.5559140
##                           SEXFemale:ClassReactive Realists
## Business                                         0.6072315
## Education                                        0.6750123
## Engineering                                      0.8462272
## Health and Public Service                        0.8833311
## Journalism                                       1.5558562
## Music                                            1.0997910
## Science                                          0.7309415
## Visual Arts and Design                           1.2275702
##                           SEXFemale:ClassBalanced Visionaries
## Business                                            0.4033619
## Education                                           0.4097312
## Engineering                                         0.4510349
## Health and Public Service                           0.4747516
## Journalism                                          0.7754180
## Music                                               0.5455321
## Science                                             0.4204668
## Visual Arts and Design                              0.6198812
## 
## Residual Deviance: 5992.526 
## AIC: 6088.526

#zscore

##                           (Intercept)  SEXFemale ClassReactive Realists
## Business                    -2.016286 -4.5247441            -0.48213312
## Education                   -4.430873  2.0070771             0.02752380
## Engineering                 -1.406463 -5.5062427             1.55602733
## Health and Public Service   -5.321198  1.2181965            -0.41811904
## Journalism                  -5.379719  0.8513522             0.05469107
## Music                       -4.097857 -3.6791836            -1.30971735
## Science                     -2.439947 -0.3993029            -1.67725899
## Visual Arts and Design      -5.544197  1.9065086            -0.30553808
##                           ClassBalanced Visionaries
## Business                                 -1.4291406
## Education                                -0.1368539
## Engineering                              -1.0023463
## Health and Public Service                 1.5141242
## Journalism                                0.6051031
## Music                                    -1.9272895
## Science                                  -2.7155219
## Visual Arts and Design                    0.7288433
##                           SEXFemale:ClassReactive Realists
## Business                                         1.3284366
## Education                                       -0.8750099
## Engineering                                     -2.0625697
## Health and Public Service                        0.8459824
## Journalism                                      -0.8917586
## Music                                            0.3169811
## Science                                          1.4918523
## Visual Arts and Design                          -0.1405066
##                           SEXFemale:ClassBalanced Visionaries
## Business                                            2.1057505
## Education                                           0.2258786
## Engineering                                        -0.2348648
## Health and Public Service                          -1.3118694
## Journalism                                         -0.4659551
## Music                                               1.8190708
## Science                                             0.8878231
## Visual Arts and Design                             -0.5047792

#pvalues

##                            (Intercept)    SEXFemale ClassReactive Realists
## Business                  4.377005e-02 6.046864e-06             0.62971139
## Education                 9.385222e-06 4.474146e-02             0.97804196
## Engineering               1.595868e-01 3.665731e-08             0.11970159
## Health and Public Service 1.030864e-07 2.231493e-01             0.67586008
## Journalism                7.460205e-08 3.945737e-01             0.95638458
## Music                     4.169930e-05 2.339818e-04             0.19029147
## Science                   1.468943e-02 6.896700e-01             0.09349185
## Visual Arts and Design    2.953057e-08 5.658425e-02             0.75995637
##                           ClassBalanced Visionaries
## Business                                 0.15296383
## Education                                0.89114626
## Engineering                              0.31617638
## Health and Public Service                0.12999433
## Journalism                               0.54511047
## Music                                    0.05394357
## Science                                  0.00661714
## Visual Arts and Design                   0.46609755
##                           SEXFemale:ClassReactive Realists
## Business                                        0.18403392
## Education                                       0.38156852
## Engineering                                     0.03915353
## Health and Public Service                       0.39756258
## Journalism                                      0.37252234
## Music                                           0.75125791
## Science                                         0.13573786
## Visual Arts and Design                          0.88825970
##                           SEXFemale:ClassBalanced Visionaries
## Business                                           0.03522603
## Education                                          0.82129586
## Engineering                                        0.81431366
## Health and Public Service                          0.18956420
## Journalism                                         0.64124766
## Music                                              0.06890063
## Science                                            0.37463591
## Visual Arts and Design                             0.61371392

#odds ratios, confidence intervels, effect size

##                           (Intercept) SEXFemale ClassReactive Realists
## Business                   0.67195712 0.2942369              0.7933381
## Education                  0.32816430 1.7559785              1.0159324
## Engineering                0.76569348 0.2213236              1.8280595
## Health and Public Service  0.18753492 1.5362140              0.7109952
## Journalism                 0.06251067 1.6268980              1.0651865
## Music                      0.37498866 0.2862923              0.3553103
## Science                    0.60913751 0.9089729              0.3281342
## Visual Arts and Design     0.09375408 2.4103078              0.7107022
##                           ClassBalanced Visionaries
## Business                                  0.6509876
## Education                                 0.9520587
## Engineering                               0.7549017
## Health and Public Service                 1.8325455
## Journalism                                1.4992645
## Music                                     0.4583835
## Science                                   0.3850631
## Visual Arts and Design                    1.4995637
##                           SEXFemale:ClassReactive Realists
## Business                                         2.2404317
## Education                                        0.5539713
## Engineering                                      0.1745747
## Health and Public Service                        2.1112550
## Journalism                                       0.2497117
## Music                                            1.4171007
## Science                                          2.9756331
## Visual Arts and Design                           0.8415736
##                           SEXFemale:ClassBalanced Visionaries
## Business                                            2.3381958
## Education                                           1.0969674
## Engineering                                         0.8994856
## Health and Public Service                           0.5364338
## Journalism                                          0.6967630
## Music                                               2.6975973
## Science                                             1.4525202
## Visual Arts and Design                              0.7313207

## , , Business
## 
##                                           2.5 %      97.5 %
## (Intercept)                         -0.78401616 -0.01110533
## SEXFemale                           -1.75329178 -0.69344800
## ClassReactive Realists              -1.17262122  0.70960972
## ClassBalanced Visionaries           -1.01797050  0.15944110
## SEXFemale:ClassReactive Realists    -0.38348336  1.99682052
## SEXFemale:ClassBalanced Visionaries  0.05880472  1.63995448
## 
## , , Education
## 
##                                           2.5 %     97.5 %
## (Intercept)                         -1.60711708 -0.6213647
## SEXFemale                            0.01321618  1.1128364
## ClassReactive Realists              -1.10979166  1.1414053
## ClassBalanced Visionaries           -0.75272671  0.6544696
## SEXFemale:ClassReactive Realists    -1.91364229  0.7323574
## SEXFemale:ClassBalanced Visionaries -0.71050884  0.8956078
## 
## , , Engineering
## 
##                                          2.5 %      97.5 %
## (Intercept)                         -0.6390118  0.10506508
## SEXFemale                           -2.0449526 -0.97130609
## ClassReactive Realists              -0.1566019  1.36311192
## ClassBalanced Visionaries           -0.8309564  0.26862094
## SEXFemale:ClassReactive Realists    -3.4039774 -0.08682774
## SEXFemale:ClassBalanced Visionaries -0.9899444  0.77807991
## 
## , , Health and Public Service
## 
##                                          2.5 %    97.5 %
## (Intercept)                         -2.2902997 -1.057281
## SEXFemale                           -0.2614162  1.120058
## ClassReactive Realists              -1.9399722  1.257793
## ClassBalanced Visionaries           -0.1783525  1.389764
## SEXFemale:ClassReactive Realists    -0.9840146  2.478580
## SEXFemale:ClassBalanced Visionaries -1.5533083  0.307684
## 
## , , Journalism
## 
##                                          2.5 %    97.5 %
## (Intercept)                         -3.7824780 -1.762358
## SEXFemale                           -0.6337375  1.607088
## ClassReactive Realists              -2.1999518  2.326251
## ClassBalanced Visionaries           -0.9067617  1.716711
## SEXFemale:ClassReactive Realists    -4.4368701  1.661974
## SEXFemale:ClassBalanced Visionaries -1.8811012  1.158481
## 
## , , Music
## 
##                                           2.5 %      97.5 %
## (Intercept)                         -1.44999478 -0.51172420
## SEXFemale                           -1.91703333 -0.58445026
## ClassReactive Realists              -2.58326555  0.51373806
## ClassBalanced Visionaries           -1.57332308  0.01322465
## SEXFemale:ClassReactive Realists    -1.80693776  2.50416380
## SEXFemale:ClassBalanced Visionaries -0.07686175  2.06158471
## 
## , , Science
## 
##                                          2.5 %      97.5 %
## (Intercept)                         -0.8939069 -0.09751559
## SEXFemale                           -0.5639040  0.37302394
## ClassReactive Realists              -2.4164879  0.18782274
## ClassBalanced Visionaries           -1.6431615 -0.26553468
## SEXFemale:ClassReactive Realists    -0.3421623  2.52307589
## SEXFemale:ClassBalanced Visionaries -0.4507996  1.19739988
## 
## , , Visual Arts and Design
## 
##                                           2.5 %     97.5 %
## (Intercept)                         -3.20388145 -1.5302788
## SEXFemale                           -0.02466689  1.7841758
## ClassReactive Realists              -2.53216513  1.8491617
## ClassBalanced Visionaries           -0.68439730  1.4947457
## SEXFemale:ClassReactive Realists    -2.57847507  2.2335115
## SEXFemale:ClassBalanced Visionaries -1.52784795  0.9020417

## Nagelkerke   McFadden 
## 0.13103413 0.03459035

lr_chi <- 2 * (logLik(m3) - logLik(m2))
df <- attr(logLik(m3), "df") - attr(logLik(m2), "df")
p_val <- pchisq(lr_chi, df = df, lower.tail = FALSE)

# Show real results
cat("Chi-square =", round(lr_chi, 2), "\n")

## Chi-square = 28.28

cat("df =", df, "\n")

## df = 16

cat("p-value =", format.pval(p_val, digits = 4), "\n")

## p-value = 0.02926

AIC(m3)

## [1] 6088.526

library(nnet)
library(dplyr)
library(tidyr)
library(flextable)
library(officer)

# Extract components
coefs <- summary(m3)$coefficients
ses <- summary(m3)$standard.errors
z <- coefs / ses
p <- (1 - pnorm(abs(z3))) * 2
or <- exp(coefs)

# Outcome and predictor labels
outcome_labels <- rownames(coefs)
predictor_labels <- colnames(coefs)

# Build long-format table manually with CI calculation
results_list <- list()
for (i in seq_along(outcome_labels)) {
  for (j in seq_along(predictor_labels)) {
    b <- coefs[i, j]
    se <- ses[i, j]
    or_val <- or[i, j]
    
    # 95% CI for OR using log(OR) ± 1.96 * SE, then exponentiate
    ci_low <- exp(b - 1.96 * se)
    ci_high <- exp(b + 1.96 * se)

    results_list[[length(results_list) + 1]] <- data.frame(
      outcome = outcome_labels[i],
      predictor = predictor_labels[j],
      B = round(b, 2),
      SE = round(se, 2),
      OR = round(or_val, 2),
      CI = paste0("[", round(ci_low, 2), ", ", round(ci_high, 2), "]"),
      p = ifelse(p[i, j] < .001, "< .001", formatC(p[i, j], digits = 3, format = "f"))
    )
  }
}
results_long <- do.call(rbind, results_list)

# Pivot to wide format
results_wide <- results_long %>%
  pivot_wider(
    names_from = predictor,
    values_from = c(B, SE, OR, CI, p),
    names_glue = "{predictor}_{.value}"
  ) %>%
  rename(`Outcome Category` = outcome)

# Create APA-style table
ft <- flextable(results_wide) %>%
  theme_booktabs() %>%
  autofit() %>%
  add_footer_lines("Note. B = log-odds; OR = odds ratio; CI = 95% confidence interval. Reference outcome = Liberal Arts and Social Sciences. Reference profile = Reserved Idealists.")

# Save to Word
save_as_docx(
  "Multinomial Logistic Regression – Model 3" = ft,
  path = "Model3_Multinomial_Wide.docx"
)

#Research Question 3 
#What is the relationship of sex and class to college discipline after controlling for race.
m4 <- multinom(COLLEGENAME ~ RACE + SEX + Class, data = new_classdata)

## # weights:  81 (64 variable)
## initial  value 3427.670341 
## iter  10 value 3036.351388
## iter  20 value 2973.358378
## iter  30 value 2968.933882
## iter  40 value 2968.593679
## final  value 2968.586945 
## converged

summary(m4)

## Call:
## multinom(formula = COLLEGENAME ~ RACE + SEX + Class, data = new_classdata)
## 
## Coefficients:
##                           (Intercept)   RACEAsian RACEBlack/African American
## Business                   -0.7675753  1.35094961                 0.31902941
## Education                  -1.0373602  0.08054225                 0.12456547
## Engineering                -0.5701545  1.81538883                 0.15431220
## Health and Public Service  -1.4432936  0.09522034                -0.25654199
## Journalism                 -2.5216043 -0.79886681                 0.66440826
## Music                      -1.1710340  0.76646120                -1.60302762
## Science                    -0.8009671  0.96893522                -0.09912244
## Visual Arts and Design     -2.2560171 -0.14712087                -0.77827770
##                           RACEHispanic/Latinx RACETwo or More Races   SEXFemale
## Business                          -0.07433533           -0.03912851 -0.82740595
## Education                         -0.16915175           -0.77843377  0.56731219
## Engineering                        0.54097129            0.14789051 -1.75856732
## Health and Public Service         -0.06780045           -0.38637601  0.20892344
## Journalism                        -0.03843928           -0.90522114  0.23624792
## Music                             -0.01365886           -0.44204428 -0.85661845
## Science                            0.30425706            0.16379111  0.09901937
## Visual Arts and Design             0.43803916           -0.55684425  0.74605513
##                           ClassReactive Realists ClassBalanced Visionaries
## Business                               0.2292810                0.07543479
## Education                             -0.4354569                0.01422118
## Engineering                            0.2820149               -0.18170337
## Health and Public Service              0.2917700                0.18235807
## Journalism                            -0.8871596                0.09643273
## Music                                 -0.8284544               -0.20700727
## Science                               -0.2489591               -0.64783052
## Visual Arts and Design                -0.5113047                0.17604257
## 
## Std. Errors:
##                           (Intercept) RACEAsian RACEBlack/African American
## Business                    0.1905321 0.3129947                  0.3536561
## Education                   0.1983243 0.3529113                  0.3029432
## Engineering                 0.1899477 0.3178967                  0.4293242
## Health and Public Service   0.2287546 0.4278662                  0.4139518
## Journalism                  0.3751394 1.0426600                  0.4909683
## Music                       0.2399169 0.4420542                  1.0293200
## Science                     0.1888222 0.3067281                  0.3680440
## Visual Arts and Design      0.3080010 0.5619642                  0.6226554
##                           RACEHispanic/Latinx RACETwo or More Races SEXFemale
## Business                            0.2689001             0.3286007 0.1895849
## Education                           0.2277434             0.3277030 0.1943241
## Engineering                         0.2536565             0.3595713 0.2089761
## Health and Public Service           0.2674921             0.3550708 0.2201844
## Journalism                          0.4450977             0.7505674 0.3672874
## Music                               0.3406352             0.4971969 0.2571516
## Science                             0.2214521             0.2768946 0.1869088
## Visual Arts and Design              0.2815356             0.4579858 0.2955808
##                           ClassReactive Realists ClassBalanced Visionaries
## Business                               0.2942590                 0.2009023
## Education                              0.3019968                 0.1731426
## Engineering                            0.2977190                 0.2161802
## Health and Public Service              0.3085587                 0.2116442
## Journalism                             0.7558486                 0.3355497
## Music                                  0.5468039                 0.2710565
## Science                                0.2736339                 0.1942025
## Visual Arts and Design                 0.4622527                 0.2447089
## 
## Residual Deviance: 5937.174 
## AIC: 6065.174

#z-scores
z4 <- summary(m4)$coefficients/summary(m4)$standard.errors
z4

##                           (Intercept)  RACEAsian RACEBlack/African American
## Business                    -4.028587  4.3162066                  0.9020894
## Education                   -5.230625  0.2282224                  0.4111842
## Engineering                 -3.001640  5.7106249                  0.3594305
## Health and Public Service   -6.309352  0.2225470                 -0.6197387
## Journalism                  -6.721779 -0.7661815                  1.3532611
## Music                       -4.880999  1.7338624                 -1.5573656
## Science                     -4.241912  3.1589382                 -0.2693223
## Visual Arts and Design      -7.324707 -0.2617976                 -1.2499332
##                           RACEHispanic/Latinx RACETwo or More Races  SEXFemale
## Business                          -0.27644219            -0.1190762 -4.3643037
## Education                         -0.74272964            -2.3754246  2.9194122
## Engineering                        2.13269227             0.4112968 -8.4151601
## Health and Public Service         -0.25346709            -1.0881661  0.9488568
## Journalism                        -0.08636146            -1.2060492  0.6432237
## Music                             -0.04009822            -0.8890729 -3.3311808
## Science                            1.37391790             0.5915288  0.5297737
## Visual Arts and Design             1.55589285            -1.2158548  2.5240314
##                           ClassReactive Realists ClassBalanced Visionaries
## Business                               0.7791811                0.37547990
## Education                             -1.4419255                0.08213566
## Engineering                            0.9472517               -0.84051812
## Health and Public Service              0.9455898                0.86162546
## Journalism                            -1.1737265                0.28738736
## Music                                 -1.5150850               -0.76370536
## Science                               -0.9098254               -3.33585094
## Visual Arts and Design                -1.1061150                0.71939590

p4 <- (1 - pnorm(abs(z4), 0, 1)) * 2 
p4

##                            (Intercept)    RACEAsian RACEBlack/African American
## Business                  5.611306e-05 1.587334e-05                  0.3670094
## Education                 1.689379e-07 8.194734e-01                  0.6809375
## Engineering               2.685294e-03 1.125621e-08                  0.7192730
## Health and Public Service 2.802063e-10 8.238881e-01                  0.5354298
## Journalism                1.795186e-11 4.435683e-01                  0.1759722
## Music                     1.055497e-06 8.294250e-02                  0.1193837
## Science                   2.216235e-05 1.583451e-03                  0.7876817
## Visual Arts and Design    2.393641e-13 7.934775e-01                  0.2113239
##                           RACEHispanic/Latinx RACETwo or More Races
## Business                           0.78220846            0.90521501
## Education                          0.45764538            0.01752877
## Engineering                        0.03294998            0.68085493
## Health and Public Service          0.79990729            0.27652181
## Journalism                         0.93117909            0.22779854
## Music                              0.96801482            0.37396390
## Science                            0.16946717            0.55416616
## Visual Arts and Design             0.11973357            0.22404025
##                              SEXFemale ClassReactive Realists
## Business                  1.275283e-05              0.4358730
## Education                 3.506922e-03              0.1493234
## Engineering               0.000000e+00              0.3435105
## Health and Public Service 3.426934e-01              0.3443578
## Journalism                5.200790e-01              0.2405046
## Music                     8.647842e-04              0.1297509
## Science                   5.962689e-01              0.3629146
## Visual Arts and Design    1.160176e-02              0.2686768
##                           ClassBalanced Visionaries
## Business                               0.7073035940
## Education                              0.9345388347
## Engineering                            0.4006179465
## Health and Public Service              0.3888936555
## Journalism                             0.7738157400
## Music                                  0.4450428484
## Science                                0.0008503875
## Visual Arts and Design                 0.4718970213

exp(coef(m4))  # Odds ratios

##                           (Intercept) RACEAsian RACEBlack/African American
## Business                   0.46413708 3.8610903                  1.3757918
## Education                  0.35438895 1.0838746                  1.1326562
## Engineering                0.56543806 6.1434645                  1.1668551
## Health and Public Service  0.23614870 1.0999012                  0.7737225
## Journalism                 0.08033063 0.4498384                  1.9433402
## Music                      0.31004620 2.1521368                  0.2012862
## Science                    0.44889465 2.6351371                  0.9056318
## Visual Arts and Design     0.10476693 0.8631896                  0.4591962
##                           RACEHispanic/Latinx RACETwo or More Races SEXFemale
## Business                            0.9283603             0.9616271 0.4371819
## Education                           0.8443808             0.4591245 1.7635207
## Engineering                         1.7176744             1.1593859 0.1722915
## Health and Public Service           0.9344469             0.6795150 1.2323507
## Journalism                          0.9622901             0.4044524 1.2664883
## Music                               0.9864340             0.6427212 0.4245954
## Science                             1.3556175             1.1779682 1.1040877
## Visual Arts and Design              1.5496656             0.5730145 2.1086652
##                           ClassReactive Realists ClassBalanced Visionaries
## Business                               1.2576955                 1.0783529
## Education                              0.6469690                 1.0143228
## Engineering                            1.3257984                 0.8338487
## Health and Public Service              1.3387951                 1.2000438
## Journalism                             0.4118238                 1.1012355
## Music                                  0.4367238                 0.8130137
## Science                                0.7796119                 0.5231796
## Visual Arts and Design                 0.5997126                 1.1924888

confint(m4) 

## , , Business
## 
##                                 2.5 %     97.5 %
## (Intercept)                -1.1410115 -0.3941392
## RACEAsian                   0.7374913  1.9644079
## RACEBlack/African American -0.3741238  1.0121826
## RACEHispanic/Latinx        -0.6013698  0.4526991
## RACETwo or More Races      -0.6831740  0.6049169
## SEXFemale                  -1.1989855 -0.4558264
## ClassReactive Realists     -0.3474560  0.8060181
## ClassBalanced Visionaries  -0.3183266  0.4691962
## 
## , , Education
## 
##                                 2.5 %     97.5 %
## (Intercept)                -1.4260688 -0.6486517
## RACEAsian                  -0.6111512  0.7722357
## RACEBlack/African American -0.4691924  0.7183233
## RACEHispanic/Latinx        -0.6155205  0.2772170
## RACETwo or More Races      -1.4207198 -0.1361477
## SEXFemale                   0.1864439  0.9481804
## ClassReactive Realists     -1.0273597  0.1564459
## ClassBalanced Visionaries  -0.3251321  0.3535745
## 
## , , Engineering
## 
##                                  2.5 %     97.5 %
## (Intercept)                -0.94244509 -0.1978639
## RACEAsian                   1.19232274  2.4384549
## RACEBlack/African American -0.68714768  0.9957721
## RACEHispanic/Latinx         0.04381366  1.0381289
## RACETwo or More Races      -0.55685624  0.8526373
## SEXFemale                  -2.16815294 -1.3489817
## ClassReactive Realists     -0.30150370  0.8655334
## ClassBalanced Visionaries  -0.60540875  0.2420020
## 
## , , Health and Public Service
## 
##                                 2.5 %     97.5 %
## (Intercept)                -1.8916445 -0.9949427
## RACEAsian                  -0.7433821  0.9338227
## RACEBlack/African American -1.0678727  0.5547887
## RACEHispanic/Latinx        -0.5920753  0.4564745
## RACETwo or More Races      -1.0823020  0.3095500
## SEXFemale                  -0.2226300  0.6404769
## ClassReactive Realists     -0.3129940  0.8965340
## ClassBalanced Visionaries  -0.2324570  0.5971732
## 
## , , Journalism
## 
##                                 2.5 %     97.5 %
## (Intercept)                -3.2568641 -1.7863445
## RACEAsian                  -2.8424429  1.2447092
## RACEBlack/African American -0.2978719  1.6266884
## RACEHispanic/Latinx        -0.9108147  0.8339361
## RACETwo or More Races      -2.3763062  0.5658639
## SEXFemale                  -0.4836221  0.9561179
## ClassReactive Realists     -2.3685957  0.5942765
## ClassBalanced Visionaries  -0.5612325  0.7540980
## 
## , , Music
## 
##                                  2.5 %     97.5 %
## (Intercept)                -1.64126236 -0.7008056
## RACEAsian                  -0.09994916  1.6328716
## RACEBlack/African American -3.62045778  0.4144025
## RACEHispanic/Latinx        -0.68129153  0.6539738
## RACETwo or More Races      -1.41653227  0.5324437
## SEXFemale                  -1.36062631 -0.3526106
## ClassReactive Realists     -1.90017042  0.2432616
## ClassBalanced Visionaries  -0.73826818  0.3242536
## 
## , , Science
## 
##                                 2.5 %     97.5 %
## (Intercept)                -1.1710517 -0.4308824
## RACEAsian                   0.3677591  1.5701113
## RACEBlack/African American -0.8204753  0.6222305
## RACEHispanic/Latinx        -0.1297812  0.7382953
## RACETwo or More Races      -0.3789122  0.7064945
## SEXFemale                  -0.2673152  0.4653540
## ClassReactive Realists     -0.7852717  0.2873535
## ClassBalanced Visionaries  -1.0284604 -0.2672007
## 
## , , Visual Arts and Design
## 
##                                 2.5 %     97.5 %
## (Intercept)                -2.8596880 -1.6523463
## RACEAsian                  -1.2485504  0.9543086
## RACEBlack/African American -1.9986599  0.4421045
## RACEHispanic/Latinx        -0.1137604  0.9898387
## RACETwo or More Races      -1.4544800  0.3407915
## SEXFemale                   0.1667275  1.3253828
## ClassReactive Realists     -1.4173034  0.3946941
## ClassBalanced Visionaries  -0.3035780  0.6556632

DescTools::PseudoR2(m4, which = c("Nagelkerke", "McFadden"))

## Nagelkerke   McFadden 
## 0.16199053 0.04350764

 lr_chi <- 2 * (logLik(m4) - logLik(m3)) 
 df <- attr(logLik(m4), "df") - attr(logLik(m3), "df") 
 p_val <- pchisq(lr_chi, df = df, lower.tail = FALSE)

#Show real results
cat("Chi-square =", round(lr_chi, 2), "\n") 

## Chi-square = 55.35

cat("df =", df, "\n") 

## df = 16

cat("p-value =", format.pval(p_val, digits = 4), "\n")

## p-value = 3.113e-06

AIC(m4)

## [1] 6065.174

library(nnet)
library(dplyr)
library(tidyr)
library(flextable)
library(officer)

# Extract components
coefs <- summary(m4)$coefficients
ses <- summary(m4)$standard.errors
z <- coefs / ses
p <- (1 - pnorm(abs(z4))) * 2
or <- exp(coefs)

# Outcome and predictor labels
outcome_labels <- rownames(coefs)
predictor_labels <- colnames(coefs)

# Build long-format table manually with CI calculation
results_list <- list()
for (i in seq_along(outcome_labels)) {
  for (j in seq_along(predictor_labels)) {
    b <- coefs[i, j]
    se <- ses[i, j]
    or_val <- or[i, j]
    
    # 95% CI for OR using log(OR) ± 1.96 * SE, then exponentiate
    ci_low <- exp(b - 1.96 * se)
    ci_high <- exp(b + 1.96 * se)

    results_list[[length(results_list) + 1]] <- data.frame(
      outcome = outcome_labels[i],
      predictor = predictor_labels[j],
      B = round(b, 2),
      SE = round(se, 2),
      OR = round(or_val, 2),
      CI = paste0("[", round(ci_low, 2), ", ", round(ci_high, 2), "]"),
      p = ifelse(p[i, j] < .001, "< .001", formatC(p[i, j], digits = 3, format = "f"))
    )
  }
}
results_long <- do.call(rbind, results_list)

# Pivot to wide format
results_wide <- results_long %>%
  pivot_wider(
    names_from = predictor,
    values_from = c(B, SE, OR, CI, p),
    names_glue = "{predictor}_{.value}"
  ) %>%
  rename(`Outcome Category` = outcome)

# Create APA-style table
ft <- flextable(results_wide) %>%
  theme_booktabs() %>%
  autofit() %>%
  add_footer_lines("Note. B = log-odds; OR = odds ratio; CI = 95% confidence interval. Reference outcome = Liberal Arts and Social Sciences. Reference profile = Reserved Idealists.")

# Save to Word
save_as_docx("Multinomial Logistic Regression – Model 5" = ft,
  path = "Model5_Multinomial_Wide.docx")

#Research Question 3 
#To what extent does sex moderate the relationship between profile membership and college disciplines?
#controlling for race
m5 <- multinom(COLLEGENAME ~ RACE + SEX * Class, data = new_classdata)

## # weights:  99 (80 variable)
## initial  value 3427.670341 
## iter  10 value 3050.536701
## iter  20 value 2962.934533
## iter  30 value 2956.040510
## iter  40 value 2954.400294
## iter  50 value 2954.308499
## final  value 2954.307723 
## converged

summary(m5)

## Call:
## multinom(formula = COLLEGENAME ~ RACE + SEX * Class, data = new_classdata)
## 
## Coefficients:
##                           (Intercept)   RACEAsian RACEBlack/African American
## Business                   -0.5334910  1.36022659                  0.2892453
## Education                  -1.0519520  0.08213296                  0.1246923
## Engineering                -0.6120770  1.82238651                  0.1681617
## Health and Public Service  -1.6239137  0.08888028                 -0.2491347
## Journalism                 -2.7461955 -0.80003957                  0.6772153
## Music                      -0.9600331  0.78013350                 -1.6367665
## Science                    -0.6373367  0.96913854                 -0.1143557
## Visual Arts and Design     -2.3926941 -0.14806256                 -0.7759781
##                           RACEHispanic/Latinx RACETwo or More Races  SEXFemale
## Business                         -0.067680439           -0.05216123 -1.2670941
## Education                        -0.165559662           -0.77970414  0.5764560
## Engineering                       0.551005633            0.14643741 -1.5723776
## Health and Public Service        -0.079827262           -0.37908456  0.4362423
## Journalism                       -0.038030114           -0.90028576  0.5129685
## Music                            -0.000825328           -0.45908794 -1.2623637
## Science                           0.303737713            0.15931300 -0.1236525
## Visual Arts and Design            0.436600453           -0.55540882  0.8966203
##                           ClassReactive Realists ClassBalanced Visionaries
## Business                             -0.21847820               -0.38126178
## Education                             0.02127940               -0.04350372
## Engineering                           0.60389369               -0.20910849
## Health and Public Service            -0.33991767                0.60982163
## Journalism                            0.06461825                0.39940766
## Music                                -1.03398731               -0.75531363
## Science                              -1.11786754               -0.92878015
## Visual Arts and Design               -0.35976531                0.40861547
##                           SEXFemale:ClassReactive Realists
## Business                                         0.8123113
## Education                                       -0.5910430
## Engineering                                     -1.7396918
## Health and Public Service                        0.7583618
## Journalism                                      -1.4221205
## Music                                            0.3843567
## Science                                          1.0956197
## Visual Arts and Design                          -0.1671222
##                           SEXFemale:ClassBalanced Visionaries
## Business                                           0.86278434
## Education                                          0.09653581
## Engineering                                       -0.05641493
## Health and Public Service                         -0.60802839
## Journalism                                        -0.39034009
## Music                                              1.04772395
## Science                                            0.40172054
## Visual Arts and Design                            -0.26151775
## 
## Std. Errors:
##                           (Intercept) RACEAsian RACEBlack/African American
## Business                    0.2138615 0.3139120                  0.3541572
## Education                   0.2584361 0.3530752                  0.3032536
## Engineering                 0.2160795 0.3190209                  0.4312215
## Health and Public Service   0.3225248 0.4282399                  0.4146026
## Journalism                  0.5293973 1.0427800                  0.4916015
## Music                       0.2581963 0.4428086                  1.0295993
## Science                     0.2162272 0.3067822                  0.3682937
## Visual Arts and Design      0.4372198 0.5622314                  0.6231956
##                           RACEHispanic/Latinx RACETwo or More Races SEXFemale
## Business                            0.2692935             0.3290230 0.2730127
## Education                           0.2278576             0.3278023 0.2811013
## Engineering                         0.2549799             0.3608361 0.2790799
## Health and Public Service           0.2679404             0.3553587 0.3527551
## Journalism                          0.4452173             0.7500677 0.5723438
## Music                               0.3413496             0.4978038 0.3413537
## Science                             0.2217030             0.2769757 0.2401284
## Visual Arts and Design              0.2815543             0.4580123 0.4621571
##                           ClassReactive Realists ClassBalanced Visionaries
## Business                               0.4830637                 0.3024090
## Education                              0.5750181                 0.3594959
## Engineering                            0.3956918                 0.2852972
## Health and Public Service              0.8160601                 0.4002708
## Journalism                             1.1563590                 0.6699121
## Music                                  0.7911801                 0.4058893
## Science                                0.6651322                 0.3522365
## Visual Arts and Design                 1.1189535                 0.5566043
##                           SEXFemale:ClassReactive Realists
## Business                                         0.6118055
## Education                                        0.6761051
## Engineering                                      0.8528539
## Health and Public Service                        0.8837919
## Journalism                                       1.5579605
## Music                                            1.1013790
## Science                                          0.7323200
## Visual Arts and Design                           1.2293030
##                           SEXFemale:ClassBalanced Visionaries
## Business                                            0.4063847
## Education                                           0.4107144
## Engineering                                         0.4565192
## Health and Public Service                           0.4752804
## Journalism                                          0.7772337
## Music                                               0.5471300
## Science                                             0.4217444
## Visual Arts and Design                              0.6211250
## 
## Residual Deviance: 5908.615 
## AIC: 6068.615

#z-scores
z5 <- summary(m5)$coefficients/summary(m5)$standard.errors
z5

##                           (Intercept)  RACEAsian RACEBlack/African American
## Business                    -2.494562  4.3331467                  0.8167143
## Education                   -4.070453  0.2326217                  0.4111815
## Engineering                 -2.832648  5.7124357                  0.3899658
## Health and Public Service   -5.035004  0.2075479                 -0.6009000
## Journalism                  -5.187400 -0.7672180                  1.3775694
## Music                       -3.718230  1.7617847                 -1.5897122
## Science                     -2.947533  3.1590439                 -0.3105014
## Visual Arts and Design      -5.472520 -0.2633481                 -1.2451597
##                           RACEHispanic/Latinx RACETwo or More Races  SEXFemale
## Business                         -0.251325940            -0.1585337 -4.6411548
## Education                        -0.726592671            -2.3785802  2.0507058
## Engineering                       2.160976590             0.4058280 -5.6341491
## Health and Public Service        -0.297929174            -1.0667660  1.2366721
## Journalism                       -0.085419225            -1.2002727  0.8962595
## Music                            -0.002417838            -0.9222267 -3.6981103
## Science                           1.370020743             0.5751877 -0.5149431
## Visual Arts and Design            1.550679520            -1.2126503  1.9400768
##                           ClassReactive Realists ClassBalanced Visionaries
## Business                             -0.45227615                -1.2607489
## Education                             0.03700649                -0.1210131
## Engineering                           1.52617188                -0.7329497
## Health and Public Service            -0.41653512                 1.5235226
## Journalism                            0.05588078                 0.5962090
## Music                                -1.30689239                -1.8608860
## Science                              -1.68066977                -2.6368087
## Visual Arts and Design               -0.32151945                 0.7341220
##                           SEXFemale:ClassReactive Realists
## Business                                         1.3277279
## Education                                       -0.8741880
## Engineering                                     -2.0398475
## Health and Public Service                        0.8580774
## Journalism                                      -0.9128091
## Music                                            0.3489777
## Science                                          1.4960942
## Visual Arts and Design                          -0.1359487
##                           SEXFemale:ClassBalanced Visionaries
## Business                                            2.1230728
## Education                                           0.2350437
## Engineering                                        -0.1235762
## Health and Public Service                          -1.2793045
## Journalism                                         -0.5022171
## Music                                               1.9149453
## Science                                             0.9525213
## Visual Arts and Design                             -0.4210389

p5 <- (1 - pnorm(abs(z5), 0, 1)) * 2
p5

##                            (Intercept)    RACEAsian RACEBlack/African American
## Business                  1.261125e-02 1.469931e-05                  0.4140917
## Education                 4.692175e-05 8.160551e-01                  0.6809395
## Engineering               4.616420e-03 1.113705e-08                  0.6965618
## Health and Public Service 4.778395e-07 8.355820e-01                  0.5479066
## Journalism                2.132507e-07 4.429519e-01                  0.1683363
## Music                     2.006238e-04 7.810568e-02                  0.1118997
## Science                   3.203210e-03 1.582877e-03                  0.7561797
## Visual Arts and Design    4.436798e-08 7.922823e-01                  0.2130730
##                           RACEHispanic/Latinx RACETwo or More Races
## Business                           0.80156212            0.87403629
## Education                          0.46747552            0.01737946
## Engineering                        0.03069715            0.68486898
## Health and Public Service          0.76575722            0.28607752
## Journalism                         0.93192811            0.23003345
## Music                              0.99807085            0.35641033
## Science                            0.17068043            0.56516437
## Visual Arts and Design             0.12097850            0.22526354
##                              SEXFemale ClassReactive Realists
## Business                  3.464674e-06             0.65107006
## Education                 4.029560e-02             0.97047983
## Engineering               1.759247e-08             0.12696707
## Health and Public Service 2.162088e-01             0.67701847
## Journalism                3.701142e-01             0.95543678
## Music                     2.172105e-04             0.19124926
## Science                   6.065928e-01             0.09282708
## Visual Arts and Design    5.237035e-02             0.74781677
##                           ClassBalanced Visionaries
## Business                                0.207399345
## Education                               0.903680664
## Engineering                             0.463589081
## Health and Public Service               0.127628010
## Journalism                              0.551035582
## Music                                   0.062760282
## Science                                 0.008369001
## Visual Arts and Design                  0.462874401
##                           SEXFemale:ClassReactive Realists
## Business                                        0.18426801
## Education                                       0.38201588
## Engineering                                     0.04136552
## Health and Public Service                       0.39084974
## Journalism                                      0.36134294
## Music                                           0.72710607
## Science                                         0.13462912
## Visual Arts and Design                          0.89186182
##                           SEXFemale:ClassBalanced Visionaries
## Business                                           0.03374775
## Education                                          0.81417484
## Engineering                                        0.90165081
## Health and Public Service                          0.20078986
## Journalism                                         0.61551480
## Music                                              0.05549948
## Science                                            0.34083268
## Visual Arts and Design                             0.67372671

exp(coef(m5))  # Odds ratios

##                           (Intercept) RACEAsian RACEBlack/African American
## Business                   0.58655374 3.8970762                  1.3354192
## Education                  0.34925532 1.0856001                  1.1327998
## Engineering                0.54222350 6.1866053                  1.1831279
## Health and Public Service  0.19712569 1.0929498                  0.7794750
## Journalism                 0.06417154 0.4493112                  1.9683886
## Music                      0.38288022 2.1817635                  0.1946083
## Science                    0.52869864 2.6356730                  0.8919406
## Visual Arts and Design     0.09138315 0.8623772                  0.4602534
##                           RACEHispanic/Latinx RACETwo or More Races SEXFemale
## Business                            0.9345591             0.9491758 0.2816489
## Education                           0.8474193             0.4585417 1.7797200
## Engineering                         1.7349969             1.1577025 0.2075511
## Health and Public Service           0.9232758             0.6844877 1.5468836
## Journalism                          0.9626840             0.4064535 1.6702420
## Music                               0.9991750             0.6318597 0.2829843
## Science                             1.3549136             1.1727049 0.8836869
## Visual Arts and Design              1.5474377             0.5738376 2.4513043
##                           ClassReactive Realists ClassBalanced Visionaries
## Business                               0.8037410                 0.6829991
## Education                              1.0215074                 0.9574290
## Engineering                            1.8292274                 0.8113072
## Health and Public Service              0.7118289                 1.8401031
## Journalism                             1.0667517                 1.4909413
## Music                                  0.3555863                 0.4698632
## Science                                0.3269763                 0.3950353
## Visual Arts and Design                 0.6978401                 1.5047330
##                           SEXFemale:ClassReactive Realists
## Business                                         2.2531095
## Education                                        0.5537494
## Engineering                                      0.1755745
## Health and Public Service                        2.1347762
## Journalism                                       0.2412020
## Music                                            1.4686692
## Science                                          2.9910357
## Visual Arts and Design                           0.8460962
##                           SEXFemale:ClassBalanced Visionaries
## Business                                            2.3697497
## Education                                           1.1013490
## Engineering                                         0.9451469
## Health and Public Service                           0.5444232
## Journalism                                          0.6768267
## Music                                               2.8511544
## Science                                             1.4943937
## Visual Arts and Design                              0.7698822

confint(m5) 

## , , Business
## 
##                                           2.5 %     97.5 %
## (Intercept)                         -0.95265192 -0.1143301
## RACEAsian                            0.74497045  1.9754827
## RACEBlack/African American          -0.40489013  0.9833807
## RACEHispanic/Latinx                 -0.59548598  0.4601251
## RACETwo or More Races               -0.69703455  0.5927121
## SEXFemale                           -1.80218917 -0.7319991
## ClassReactive Realists              -1.16526569  0.7283093
## ClassBalanced Visionaries           -0.97397248  0.2114489
## SEXFemale:ClassReactive Realists    -0.38680553  2.0114281
## SEXFemale:ClassBalanced Visionaries  0.06628492  1.6592838
## 
## , , Education
## 
##                                           2.5 %     97.5 %
## (Intercept)                         -1.55847749 -0.5454266
## RACEAsian                           -0.60988163  0.7741475
## RACEBlack/African American          -0.46967394  0.7190585
## RACEHispanic/Latinx                 -0.61215235  0.2810330
## RACETwo or More Races               -1.42218491 -0.1372234
## SEXFemale                            0.02550765  1.1274044
## ClassReactive Realists              -1.10573546  1.1482943
## ClassBalanced Visionaries           -0.74810281  0.6610954
## SEXFemale:ClassReactive Realists    -1.91618468  0.7340987
## SEXFemale:ClassBalanced Visionaries -0.70844959  0.9015212
## 
## , , Engineering
## 
##                                           2.5 %      97.5 %
## (Intercept)                         -1.03558495 -0.18856907
## RACEAsian                            1.19711700  2.44765603
## RACEBlack/African American          -0.67701700  1.01334031
## RACEHispanic/Latinx                  0.05125418  1.05075709
## RACETwo or More Races               -0.56078841  0.85366323
## SEXFemale                           -2.11936415 -1.02539114
## ClassReactive Realists              -0.17164798  1.37943536
## ClassBalanced Visionaries           -0.76828069  0.35006370
## SEXFemale:ClassReactive Realists    -3.41125459 -0.06812892
## SEXFemale:ClassBalanced Visionaries -0.95117616  0.83834631
## 
## , , Health and Public Service
## 
##                                          2.5 %     97.5 %
## (Intercept)                         -2.2560508 -0.9917767
## RACEAsian                           -0.7504546  0.9282151
## RACEBlack/African American          -1.0617410  0.5634715
## RACEHispanic/Latinx                 -0.6049808  0.4453263
## RACETwo or More Races               -1.0755748  0.3174057
## SEXFemale                           -0.2551449  1.1276295
## ClassReactive Realists              -1.9393660  1.2595306
## ClassBalanced Visionaries           -0.1746947  1.3943380
## SEXFemale:ClassReactive Realists    -0.9738384  2.4905620
## SEXFemale:ClassBalanced Visionaries -1.5395609  0.3235041
## 
## , , Journalism
## 
##                                          2.5 %     97.5 %
## (Intercept)                         -3.7837952 -1.7085958
## RACEAsian                           -2.8438508  1.2437717
## RACEBlack/African American          -0.2863061  1.6407366
## RACEHispanic/Latinx                 -0.9106399  0.8345797
## RACETwo or More Races               -2.3703914  0.5698199
## SEXFemale                           -0.6088046  1.6347417
## ClassReactive Realists              -2.2018038  2.3310403
## ClassBalanced Visionaries           -0.9135959  1.7124113
## SEXFemale:ClassReactive Realists    -4.4756669  1.6314259
## SEXFemale:ClassBalanced Visionaries -1.9136902  1.1330100
## 
## , , Music
## 
##                                           2.5 %     97.5 %
## (Intercept)                         -1.46608849 -0.4539777
## RACEAsian                           -0.08775550  1.6480225
## RACEBlack/African American          -3.65474406  0.3812110
## RACEHispanic/Latinx                 -0.66985827  0.6682076
## RACETwo or More Races               -1.43476540  0.5165895
## SEXFemale                           -1.93140471 -0.5933227
## ClassReactive Realists              -2.58467190  0.5166973
## ClassBalanced Visionaries           -1.55084197  0.0402147
## SEXFemale:ClassReactive Realists    -1.77430654  2.5430199
## SEXFemale:ClassBalanced Visionaries -0.02463108  2.1200790
## 
## , , Science
## 
##                                          2.5 %     97.5 %
## (Intercept)                         -1.0611342 -0.2135392
## RACEAsian                            0.3678564  1.5704207
## RACEBlack/African American          -0.8361980  0.6074866
## RACEHispanic/Latinx                 -0.1307922  0.7382676
## RACETwo or More Races               -0.3835494  0.7021754
## SEXFemale                           -0.5942954  0.3469905
## ClassReactive Realists              -2.4215027  0.1857676
## ClassBalanced Visionaries           -1.6191509 -0.2384094
## SEXFemale:ClassReactive Realists    -0.3397012  2.5309406
## SEXFemale:ClassBalanced Visionaries -0.4248834  1.2283244
## 
## , , Visual Arts and Design
## 
##                                            2.5 %     97.5 %
## (Intercept)                         -3.249629144 -1.5357591
## RACEAsian                           -1.250015783  0.9538907
## RACEBlack/African American          -1.997419071  0.4454629
## RACEHispanic/Latinx                 -0.115235792  0.9884367
## RACETwo or More Races               -1.453096519  0.3422789
## SEXFemale                           -0.009190983  1.8024315
## ClassReactive Realists              -2.552873796  1.8333432
## ClassBalanced Visionaries           -0.682308969  1.4995399
## SEXFemale:ClassReactive Realists    -2.576511728  2.2422674
## SEXFemale:ClassBalanced Visionaries -1.478900356  0.9558649

DescTools::PseudoR2(m5, which = c("Nagelkerke", "McFadden"))

## Nagelkerke   McFadden 
## 0.17753791 0.04810847

 lr_chi <- 2 * (logLik(m5) - logLik(m4)) 
 df <- attr(logLik(m5), "df") - attr(logLik(m4), "df") 
 p_val <- pchisq(lr_chi, df = df, lower.tail = FALSE)

#Show real results

cat("Chi-square =", round(lr_chi, 2), "\n") 

## Chi-square = 28.56

cat("df =", df, "\n") 

## df = 16

cat("p-value =", format.pval(p_val, digits = 4), "\n")

## p-value = 0.02709

AIC(m5)

## [1] 6068.615

library(nnet)
library(dplyr)
library(tidyr)
library(flextable)
library(officer)

# Extract components
coefs <- summary(m5)$coefficients
ses <- summary(m5)$standard.errors
z <- coefs / ses
p <- (1 - pnorm(abs(z5))) * 2
or <- exp(coefs)

# Outcome and predictor labels
outcome_labels <- rownames(coefs)
predictor_labels <- colnames(coefs)

# Build long-format table manually with CI calculation
results_list <- list()
for (i in seq_along(outcome_labels)) {
  for (j in seq_along(predictor_labels)) {
    b <- coefs[i, j]
    se <- ses[i, j]
    or_val <- or[i, j]
    
    # 95% CI for OR using log(OR) ± 1.96 * SE, then exponentiate
    ci_low <- exp(b - 1.96 * se)
    ci_high <- exp(b + 1.96 * se)

    results_list[[length(results_list) + 1]] <- data.frame(
      outcome = outcome_labels[i],
      predictor = predictor_labels[j],
      B = round(b, 2),
      SE = round(se, 2),
      OR = round(or_val, 2),
      CI = paste0("[", round(ci_low, 2), ", ", round(ci_high, 2), "]"),
      p = ifelse(p[i, j] < .001, "< .001", formatC(p[i, j], digits = 3, format = "f"))
    )
  }
}
results_long <- do.call(rbind, results_list)

# Pivot to wide format
results_wide <- results_long %>%
  pivot_wider(
    names_from = predictor,
    values_from = c(B, SE, OR, CI, p),
    names_glue = "{predictor}_{.value}"
  ) %>%
  rename(`Outcome Category` = outcome)

# Create APA-style table
ft <- flextable(results_wide) %>%
  theme_booktabs() %>%
  autofit() %>%
  add_footer_lines("Note. B = log-odds; OR = odds ratio; CI = 95% confidence interval. Reference outcome = Liberal Arts and Social Sciences. Reference profile = Reserved Idealists.")

# Save to Word
save_as_docx("Multinomial Logistic Regression – Model 5" = ft,
  path = "Model5_Multinomial_Wide.docx")