The autoFC package is an end-to-end toolkit designed for
Automated Test Assembly (ATA) and scoring of
Multidimensional Forced-Choice (MFC) measures, covering the whole life
cycle of MFC, from data preparation, automated test assembly, scoring
(using R, Mplus, or Stan), to data simulation, and many more.
This vignette demonstrates the core workflow of the package:
Loading package and example data (Likert responses, item information, different block designs).
Constructing an initial random set of blocks.
Optimizing blocks using Simulated Annealing.
Examining the scale-level trait-pair diagnostics.
Scoring respondents using classical Ipsative (Sum) Scoring.
Scoring respondents using TIRT Scoring.
We begin by loading autoFC and our built-in dataset
containing responses to 60 HEXACO items from 2,177 respondents.
library(autoFC)
# Load the built-in HEXACO data
data("HEXACO_example_data")
head(HEXACO_example_data[, 1:5])
#> Group SS1 SS2 SS3 SS4
#> 1 FC1 2 3 3 3
#> 2 FC1 3 5 2 4
#> 3 FC1 1 4 3 4
#> 4 FC1 1 3 1 3
#> 5 FC1 3 4 2 3
#> 6 FC1 4 2 1 1We also load the keying and factor information of these items. For use in later steps, we manually add in the mean ratings of these items.
data("FC_item_info")
FC_item_info$M_Score <- colMeans(HEXACO_example_data[, -1], na.rm = TRUE)
head(FC_item_info)
#> Item ID keying factor M_Score
#> 1 1 -1 openness 2.559095
#> 2 2 1 conscientiousness 3.795014
#> 3 3 1 agreeableness 2.839335
#> 4 4 1 extraversion 3.432133
#> 5 5 1 emotionality 3.206371
#> 6 6 1 honestyhumility 3.481994Before we can optimize, we can construct a starting layout of blocks. We will group the 60 items into 20 triplet blocks (block size = 3) in a completely random manner.
set.seed(123)
# Build 20 random triplets from the 60 items
starting_blocks <- make_random_block(total_items = 60, block_size = 3)
starting_blocks
#> [,1] [,2] [,3]
#> [1,] 31 15 51
#> [2,] 14 3 42
#> [3,] 50 43 37
#> [4,] 57 25 26
#> [5,] 27 5 48
#> [6,] 28 9 29
#> [7,] 35 8 49
#> [8,] 7 44 19
#> [9,] 36 58 17
#> [10,] 12 59 10
#> [11,] 13 39 38
#> [12,] 45 60 23
#> [13,] 21 53 24
#> [14,] 6 2 47
#> [15,] 41 33 32
#> [16,] 30 20 1
#> [17,] 46 11 34
#> [18,] 22 52 54
#> [19,] 16 55 4
#> [20,] 56 18 40Next, we run the core optimization engine. In this case, we want to find a design that:
Items in the same block measure different traits (preventing trait overlap).
Items in the same block are matched closely on their mean scores (i.e., social desirability rating).
(In this case, we run a fast optimization with a rather high
cooling rate. For real-world applications, we recommend setting
temp_cooling to values closer to 1, and
temp_stop_ratio to be smaller values, both of which can
ensure more comprehensive optimization)
# Run the simulated annealing optimizer
set.seed(2026)
optimized_test <- optimize_blocks(
block = starting_blocks,
total_items = 60,
item_chars = FC_item_info[, -1], # Containing item characteristics (Keying, factor, mean scores)
# We give keying a weight of 1, factor weight of 2 (soft constraints for preventing overlap; hard constraints can be added as long as you provide target_dist parameter)
# Weight for mean scores is set higher at -5 (because we want to REDUCE the absolute difference or variance of item mean scores within a block)
char_weights = c(1, 2, -5),
optim_funcs = c("var", "facfun", "var"), # Minimize variance for item mean scores
temp_cooling = 0.999, # Fast cooling for vignette speed
temp_stop_ratio = 1e-6
)
#> Optimizing forced-choice blocks via Simulated Annealing...
#> | | | 0% | | | 1% | |= | 1% | |= | 2% | |= | 3% | |== | 4% | |=== | 5% | |=== | 6% | |=== | 7% | |==== | 7% | |==== | 8% | |==== | 9% | |===== | 9% | |===== | 10% | |===== | 11% | |====== | 12% | |======= | 13% | |======= | 14% | |======== | 15% | |======== | 16% | |======== | 17% | |========= | 17% | |========= | 18% | |========= | 19% | |========== | 20% | |=========== | 21% | |=========== | 22% | |============ | 23% | |============ | 24% | |============ | 25% | |============= | 25% | |============= | 26% | |============= | 27% | |============== | 28% | |============== | 29% | |=============== | 30% | |================ | 31% | |================ | 32% | |================ | 33% | |================= | 33% | |================= | 34% | |================= | 35% | |================== | 35% | |================== | 36% | |================== | 37% | |=================== | 38% | |==================== | 39% | |==================== | 40% | |==================== | 41% | |===================== | 41% | |===================== | 42% | |===================== | 43% | |====================== | 43% | |====================== | 44% | |====================== | 45% | |======================= | 46% | |======================== | 47% | |======================== | 48% | |======================== | 49% | |========================= | 49% | |========================= | 50% | |========================= | 51% | |========================== | 51% | |========================== | 52% | |========================== | 53% | |=========================== | 54% | |============================ | 55% | |============================ | 56% | |============================= | 57% | |============================= | 58% | |============================= | 59% | |============================== | 59% | |============================== | 60% | |============================== | 61% | |=============================== | 62% | |================================ | 63% | |================================ | 64% | |================================= | 65% | |================================= | 66% | |================================= | 67% | |================================== | 67% | |================================== | 68% | |================================== | 69% | |=================================== | 70% | |=================================== | 71% | |==================================== | 72% | |===================================== | 73% | |===================================== | 74% | |===================================== | 75% | |====================================== | 75% | |====================================== | 76% | |====================================== | 77% | |======================================= | 77% | |======================================= | 78% | |======================================= | 79% | |======================================== | 80% | |========================================= | 81% | |========================================= | 82% | |========================================= | 83% | |========================================== | 83% | |========================================== | 84% | |========================================== | 85% | |=========================================== | 85% | |=========================================== | 86% | |=========================================== | 87% | |============================================ | 88% | |============================================= | 89% | |============================================= | 90% | |============================================= | 91% | |============================================== | 91% | |============================================== | 92% | |============================================== | 93% | |=============================================== | 93% | |=============================================== | 94% | |=============================================== | 95% | |================================================ | 96% | |================================================= | 97% | |================================================= | 98% | |==================================================| 99% | |==================================================| 100%
# View the optimized block matrix
final_blocks <- optimized_test$block_final
head(FC_item_info[c(t(final_blocks)),])
#> Item ID keying factor M_Score
#> 24 24 -1 honestyhumility 2.281625
#> 40 40 1 extraversion 2.703139
#> 21 21 -1 agreeableness 2.486150
#> 45 45 1 agreeableness 3.491228
#> 10 10 -1 extraversion 3.005078
#> 13 13 1 openness 3.499077Good FC scales should ideally have even distribution of trait-pair
comparisons. We can use the summarize_trait_pairs()
function to check out how many equal-keyed and mixed-keyed trait pairs
our optimized test generated:
# Check the structural pair distribution of our constructed test
diagnostics <- summarize_trait_pairs(
blocks = final_blocks,
item_chars = FC_item_info,
trait_col = "factor",
key_col = "keying"
)
# View the diagnostic table
diagnostics
#> trait_pair equal mixed total
#> 1 agreeableness-conscientiousness 1 3 4
#> 2 agreeableness-emotionality 0 3 3
#> 3 agreeableness-extraversion 1 3 4
#> 4 agreeableness-honestyhumility 2 3 5
#> 5 agreeableness-openness 1 3 4
#> 6 conscientiousness-emotionality 1 2 3
#> 7 conscientiousness-extraversion 0 3 3
#> 8 conscientiousness-honestyhumility 4 0 4
#> 9 conscientiousness-openness 5 1 6
#> 10 emotionality-extraversion 1 3 4
#> 11 emotionality-honestyhumility 2 2 4
#> 12 emotionality-openness 3 3 6
#> 13 extraversion-honestyhumility 0 6 6
#> 14 extraversion-openness 1 2 3
#> 15 honestyhumility-openness 0 1 1You may notice that the trait pairs are not quite evenly distributed.
To ensure more balanced distribution (and also prevent trait
overlapping), we can specify the desired distribution of equally keyed
and mixed keyed pairs using the build_target_dist()
function.
target_dist <- build_target_dist(traits = unique(FC_item_info$factor), total_pairs = 60,
equal_mixed_ratio = c(1, 1), allow_same_trait = FALSE)
head(target_dist)
#> trait1 trait2 match_type target
#> 1 agreeableness conscientiousness equal 2
#> 2 agreeableness emotionality equal 2
#> 3 agreeableness extraversion equal 2
#> 4 agreeableness honestyhumility equal 2
#> 5 agreeableness openness equal 2
#> 6 conscientiousness emotionality equal 2Then, we specify this desired distribution in the
optimized_test() function.
optimized_test2 <- optimize_blocks(
block = starting_blocks,
total_items = 60,
item_chars = FC_item_info[, -1],
char_weights = c(1, 2, -5),
optim_funcs = c("var", "facfun", "var"),
temp_cooling = 0.999,
target_dist = target_dist, # NEW: Now we have a pre-specified target distribution
trait_col = "factor", # NEW: Now we should tell optimize_blocks() which column specifies item traits in item_chars
key_col = "keying", # NEW: Now we should tell optimize_blocks() which column specifies item keying in item_chars
scale_fit_weight = 100, # NEW: How much do we value the consistency with our desired target distribution?
prevent_overlap = TRUE, # NEW: Don't put items measuring the same traits in the same block!
temp_stop_ratio = 1e-6)
#> Optimizing forced-choice blocks via Simulated Annealing...
#> | | | 0% | |= | 1% | |= | 3% | |== | 4% | |=== | 6% | |=== | 7% | |==== | 8% | |===== | 10% | |====== | 11% | |====== | 13% | |======= | 14% | |======== | 15% | |======== | 17% | |========= | 18% | |========== | 20% | |========== | 21% | |=========== | 22% | |============ | 24% | |============= | 25% | |============= | 26% | |============== | 28% | |============== | 29% | |=============== | 30% | |================ | 32% | |================ | 33% | |================= | 34% | |================== | 36% | |=================== | 37% | |=================== | 39% | |==================== | 40% | |===================== | 41% | |===================== | 43% | |====================== | 44% | |======================= | 46% | |======================== | 47% | |======================== | 48% | |========================= | 50% | |========================== | 51% | |========================== | 52% | |=========================== | 54% | |============================ | 55% | |============================ | 56% | |============================= | 58% | |============================== | 59% | |============================== | 61% | |=============================== | 62% | |================================ | 63% | |================================ | 64% | |================================= | 66% | |================================== | 67% | |================================== | 69% | |=================================== | 70% | |==================================== | 71% | |==================================== | 73% | |===================================== | 74% | |====================================== | 75% | |====================================== | 77% | |======================================= | 78% | |======================================== | 80% | |========================================= | 81% | |========================================= | 82% | |========================================== | 84% | |=========================================== | 85% | |=========================================== | 86% | |============================================ | 88% | |============================================= | 89% | |============================================= | 90% | |============================================== | 92% | |=============================================== | 93% | |=============================================== | 95% | |================================================ | 96% | |================================================= | 97% | |================================================= | 99% | |==================================================| 100%
final_blocks2 <- optimized_test2$block_final
head(FC_item_info[c(t(final_blocks2)),])
#> Item ID keying factor M_Score
#> 60 60 -1 honestyhumility 2.518467
#> 50 50 1 conscientiousness 3.160665
#> 16 16 1 extraversion 2.811634
#> 45 45 1 agreeableness 3.491228
#> 11 11 1 emotionality 3.770083
#> 38 38 1 conscientiousness 3.896584Running the diagnostic again, you will see that now the trait
distribution now aligns with our desired settings. You may further tweak
target_dist to try other specical distributions -
build_target_dist() can also check the feasibility of your
design for you.
# Check the structural pair distribution of our constructed test
diagnostics2 <- summarize_trait_pairs(
blocks = final_blocks2,
item_chars = FC_item_info,
trait_col = "factor",
key_col = "keying"
)
# View the diagnostic table
diagnostics2
#> trait_pair equal mixed total
#> 1 agreeableness-conscientiousness 2 2 4
#> 2 agreeableness-emotionality 2 2 4
#> 3 agreeableness-extraversion 2 2 4
#> 4 agreeableness-honestyhumility 2 2 4
#> 5 agreeableness-openness 2 2 4
#> 6 conscientiousness-emotionality 2 2 4
#> 7 conscientiousness-extraversion 2 2 4
#> 8 conscientiousness-honestyhumility 2 2 4
#> 9 conscientiousness-openness 2 2 4
#> 10 emotionality-extraversion 2 2 4
#> 11 emotionality-honestyhumility 2 2 4
#> 12 emotionality-openness 2 2 4
#> 13 extraversion-honestyhumility 2 2 4
#> 14 extraversion-openness 2 2 4
#> 15 honestyhumility-openness 2 2 4Now for the actual scoring. Once your participants take the newly constructed test and you obtain their pairwise binary responses, you can easily calculate their classical Ipsative (Sum) Scores. Our scoring engine automatically handles reverse-keying logic and safely handles partial ranking data (like MOLE formats).
In the following part, we use the one of the actual FC scales constructed in our recent study (Li et al., 2025), to demonstrate how data processing and scoring can be done. This scale has a block size of 3 and is designed in MOLE format.
We first load the response data and peek into it:
data("MOLE_data")
MOLE_data <- MOLE_data[!is.na(MOLE_data$Q1_0_GROUP_T1),]
head(MOLE_data)
#> Q1_0_GROUP_T1 Q1_1_GROUP_T1 Q2_0_GROUP_T1 Q2_1_GROUP_T1 Q3_0_GROUP_T1
#> 1 2 3 2 3 3
#> 2 3 1 1 2 3
#> 3 2 1 1 3 3
#> 4 2 3 1 3 3
#> 5 2 1 1 3 1
#> 6 1 3 1 2 3
#> Q3_1_GROUP_T1 Q4_0_GROUP_T1 Q4_1_GROUP_T1 Q5_0_GROUP_T1 Q5_1_GROUP_T1
#> 1 2 3 1 1 2
#> 2 1 1 3 1 2
#> 3 2 3 2 3 2
#> 4 2 1 3 1 3
#> 5 2 3 1 2 1
#> 6 2 3 1 2 3
#> Q6_0_GROUP_T1 Q6_1_GROUP_T1 Q7_0_GROUP_T1 Q7_1_GROUP_T1 Q8_0_GROUP_T1
#> 1 3 1 3 2 1
#> 2 1 2 1 3 1
#> 3 2 1 3 1 1
#> 4 1 3 1 3 3
#> 5 1 3 3 1 2
#> 6 3 1 2 1 3
#> Q8_1_GROUP_T1 Q9_0_GROUP_T1 Q9_1_GROUP_T1 Q10_0_GROUP_T1 Q10_1_GROUP_T1
#> 1 3 3 2 3 1
#> 2 2 2 1 1 3
#> 3 3 3 2 1 3
#> 4 2 1 2 1 3
#> 5 1 1 3 3 2
#> 6 1 2 1 1 2
#> Q11_0_GROUP_T1 Q11_1_GROUP_T1 Q12_0_GROUP_T1 Q12_1_GROUP_T1 Q13_0_GROUP_T1
#> 1 2 1 3 2 3
#> 2 3 1 1 3 1
#> 3 2 1 2 1 3
#> 4 2 3 3 1 3
#> 5 1 3 1 3 3
#> 6 1 2 1 2 3
#> Q13_1_GROUP_T1 Q14_0_GROUP_T1 Q14_1_GROUP_T1 Q15_0_GROUP_T1 Q15_1_GROUP_T1
#> 1 1 1 3 3 1
#> 2 2 2 1 3 1
#> 3 2 2 3 3 2
#> 4 2 3 2 2 3
#> 5 1 1 3 3 1
#> 6 2 3 1 2 1
#> Q16_0_GROUP_T1 Q16_1_GROUP_T1 Q17_0_GROUP_T1 Q17_1_GROUP_T1 Q18_0_GROUP_T1
#> 1 1 3 3 2 2
#> 2 2 1 1 2 1
#> 3 1 2 1 3 3
#> 4 2 3 2 3 1
#> 5 1 3 1 2 1
#> 6 1 3 3 2 1
#> Q18_1_GROUP_T1 Q19_0_GROUP_T1 Q19_1_GROUP_T1 Q20_0_GROUP_T1 Q20_1_GROUP_T1
#> 1 3 2 3 2 1
#> 2 3 3 1 3 2
#> 3 2 3 2 1 3
#> 4 3 1 3 3 1
#> 5 2 1 3 1 2
#> 6 3 3 2 3 2
#> Group
#> 1 FC1
#> 2 FC1
#> 3 FC1
#> 4 FC1
#> 5 FC1
#> 6 FC1This dataset is directly exported from Qualtrics, so it is as close to real-world data you will encounter as possible. The FC scale contains 20 blocks, which are represented as prefix Q1-Q20 in the column names.
With each block, the “0_GROUP” columns represents the “MOST like me” options (i.e., Which of the 3 items in that block is chosen as MOST like me), and the “1_GROUP” columns represents the “LEAST like me” options.
We use the response data from the first group, and then convert the MOLE response into pairwise format:
resp_data <- MOLE_data[MOLE_data$Group == "FC1", ]
resp_data <- resp_data[, -41] ### Remove the last column indicating group
resp_pairwise_data <- convert_mole_to_pairwise(resp_data, n_blocks = 20, block_size = 3)
### This data will be readily used for later scoring!
head(resp_pairwise_data)
#> i1i2 i1i3 i2i3 i4i5 i4i6 i5i6 i7i8 i7i9 i8i9 i10i11 i10i12 i11i12 i13i14
#> 1 0 1 1 0 1 1 1 0 0 0 0 0 1
#> 2 0 0 0 1 1 0 0 0 0 1 1 1 1
#> 3 0 0 1 1 1 1 1 0 0 1 0 0 1
#> 4 0 1 1 1 1 1 1 0 0 1 1 1 1
#> 5 0 0 1 1 1 1 1 1 0 0 0 0 0
#> 6 1 1 1 1 1 0 1 0 0 0 0 0 0
#> i13i15 i14i15 i16i17 i16i18 i17i18 i19i20 i19i21 i20i21 i22i23 i22i24 i23i24
#> 1 1 0 0 0 0 1 0 0 1 1 1
#> 2 1 0 1 1 0 1 1 1 1 1 0
#> 3 0 0 0 0 1 0 0 0 1 1 1
#> 4 1 1 1 1 1 1 1 1 1 0 0
#> 5 0 1 1 1 1 0 0 0 0 0 1
#> 6 1 1 0 0 0 0 0 1 0 0 0
#> i25i26 i25i27 i26i27 i28i29 i28i30 i29i30 i31i32 i31i33 i32i33 i34i35 i34i36
#> 1 1 0 0 0 0 0 0 0 1 1 0
#> 2 0 0 1 1 1 1 0 0 0 1 1
#> 3 1 0 0 1 1 1 0 0 1 0 0
#> 4 1 1 0 1 1 1 0 1 1 0 0
#> 5 1 1 1 1 0 0 1 1 1 1 1
#> 6 0 0 1 1 1 0 1 1 0 1 1
#> i35i36 i37i38 i37i39 i38i39 i40i41 i40i42 i41i42 i43i44 i43i45 i44i45 i46i47
#> 1 0 0 0 0 1 1 1 0 0 0 1
#> 2 1 1 1 0 0 0 1 0 0 0 0
#> 3 1 1 0 0 0 1 1 1 0 0 1
#> 4 0 1 0 0 1 0 0 0 1 1 0
#> 5 1 0 0 0 1 1 1 0 0 0 1
#> 6 0 1 0 0 0 0 0 0 0 1 1
#> i46i48 i47i48 i49i50 i49i51 i50i51 i52i53 i52i54 i53i54 i55i56 i55i57 i56i57
#> 1 1 1 1 0 0 0 1 1 0 1 1
#> 2 0 1 1 1 0 1 1 1 0 0 0
#> 3 1 0 1 1 1 1 0 0 1 0 0
#> 4 1 1 0 1 1 1 1 1 1 1 1
#> 5 1 1 1 1 0 1 1 0 1 1 1
#> 6 1 1 1 0 0 1 1 1 1 0 0
#> i58i59 i58i60 i59i60
#> 1 0 0 1
#> 2 1 0 0
#> 3 1 1 1
#> 4 0 0 0
#> 5 1 1 0
#> 6 1 0 0Now we calculate respondents’ ipsative trait scores using the
score_tirt_ipsative() function.
You need to specify a key_matrix and tell the function
which column specifies the trait (trait_col), and which
column specifies keying (key_col).
data("FC_blocks")
### Because blocks in FC1 do not follow 1, 2, 3... 60 item order, we need to adjust into item orders that are actually presented in FC1
FC1_item_info <- FC_item_info[FC_blocks$FC1_Blocks, ]
ipsative_scores <- score_tirt_ipsative(resp_pairwise_data, n_blocks = 20, block_size = 3,
key_matrix = FC1_item_info, trait_col = "factor", key_col = "keying")
head(ipsative_scores)
#> conscientiousness emotionality openness extraversion honestyhumility
#> 1 10 4 12 7 11
#> 2 16 18 8 7 12
#> 3 17 9 12 10 2
#> 4 6 12 16 11 14
#> 5 11 9 10 8 12
#> 6 7 14 10 7 15
#> agreeableness
#> 1 12
#> 2 5
#> 3 8
#> 4 3
#> 5 10
#> 6 5Modern scoring models of FC measures further utilize the information incorporated in the pairwise comparisons. We showcase how TIRT models can be used for FC scoring below.
autoFC provides three avenues for TIRT FC scoring: Using
lavaan, Mplus and Stan.
Due to proprietary constraints for Mplus, we showcase how scoring is done in lavaan and Stan below.
For lavaan, we first need to build up the scoring lavaan model, using
generate_tirt_lavaan_syntax().
tirt_lavaan <- generate_tirt_lavaan_syntax(n_blocks = 20, block_size = 3, key_matrix = FC1_item_info,
trait_col = "factor", key_col = "keying", model_type = "TFM",
force_positive_variances = FALSE) ## In practice, you can set it to TRUE
# cat(tirt_lavaan)Next, we fit the model using the pairwise input data:
library(lavaan)
example_fit_lavaan <- sem(tirt_lavaan, data = resp_pairwise_data, parameterization = "theta",
estimator = "ULSMV", verbose = TRUE, ordered = TRUE, std.lv = FALSE, mimic = "mplus")We can now readily score the respondents and produce standard errors
using our score_tirt_lavaan() almost instantly!
These scores also correlated highly with traditional ipsative scores.
### Now check out how the scores correlated with ipsative scores.
cor(tirt_lavaan_scores$honestyhumility, ipsative_scores$honestyhumility)
#> [1] 0.9214905
cor(tirt_lavaan_scores$emotionality, ipsative_scores$emotionality)
#> [1] 0.9292778
cor(tirt_lavaan_scores$extraversion, ipsative_scores$extraversion)
#> [1] 0.9093443
cor(tirt_lavaan_scores$agreeableness, ipsative_scores$agreeableness)
#> [1] 0.9339512
cor(tirt_lavaan_scores$conscientiousness, ipsative_scores$conscientiousness)
#> [1] 0.858016
cor(tirt_lavaan_scores$openness, ipsative_scores$openness)
#> [1] 0.9374109For Stan, we also need to first prepare data ready for Stan…
stan_data <- prepare_tirt_stan_data(resp_pairwise_data, n_blocks = 20, block_size = 3,
key_matrix = FC1_item_info, trait_col = "factor", key_col = "keying")And then estimate the model! Note: In your case, you may need to install cmdstanr before you proceed.
You can install the latest release of the cmdstanr R package with
install.packages("cmdstanr", repos = c('https://stan-dev.r-universe.dev', getOption("repos")))
Then run:
cmdstanr::install_cmdstan()
example_fit_stan <- score_tirt_stan(stan_data, chains = 4, parallel_chains = 4,
threads_per_chain = 4,
iter_warmup = 1000, iter_sampling = 1000,
init = 0)We then check out how well the scores estimated from different methods converge:
tirt_stan_scores <- example_fit_stan$scores
### Correlation between stan and lavaan scores
cor(tirt_stan_scores$honestyhumility, tirt_lavaan_scores$honestyhumility)
#> [1] 0.9263355
cor(tirt_stan_scores$emotionality, tirt_lavaan_scores$emotionality)
#> [1] 0.9222487
cor(tirt_stan_scores$extraversion, tirt_lavaan_scores$extraversion)
#> [1] 0.7837405
cor(tirt_stan_scores$agreeableness, tirt_lavaan_scores$agreeableness)
#> [1] 0.9697347
cor(tirt_stan_scores$conscientiousness, tirt_lavaan_scores$conscientiousness)
#> [1] 0.8923431
cor(tirt_stan_scores$openness, tirt_lavaan_scores$openness)
#> [1] 0.9605085
### Correlation between stan and ipsative scores
cor(tirt_stan_scores$honestyhumility, ipsative_scores$honestyhumility)
#> [1] 0.9405876
cor(tirt_stan_scores$emotionality, ipsative_scores$emotionality)
#> [1] 0.9560027
cor(tirt_stan_scores$extraversion, ipsative_scores$extraversion)
#> [1] 0.8440321
cor(tirt_stan_scores$agreeableness, ipsative_scores$agreeableness)
#> [1] 0.920745
cor(tirt_stan_scores$conscientiousness, ipsative_scores$conscientiousness)
#> [1] 0.8446273
cor(tirt_stan_scores$openness, ipsative_scores$openness)
#> [1] 0.9224288Finally, we compute Likert sum scores and see how FC scores were consistent with their Likert counterpart!
HEXACO_example_data$H_SUM = rowSums(HEXACO_example_data[, c(7, 19, 37, 55)]) + 36 - rowSums(HEXACO_example_data[, c(13, 25, 31, 43, 49, 61)])
HEXACO_example_data$E_SUM = rowSums(HEXACO_example_data[, c(6, 12, 18, 24, 30, 48)]) + 24 - rowSums(HEXACO_example_data[, c(36, 42 ,54, 60)])
HEXACO_example_data$X_SUM = rowSums(HEXACO_example_data[, c(5, 17, 23, 35, 41, 59)]) + 24 - rowSums(HEXACO_example_data[, c(11, 29, 47, 53)])
HEXACO_example_data$A_SUM = rowSums(HEXACO_example_data[, c(4, 28, 34, 40, 46, 52)]) + 24 - rowSums(HEXACO_example_data[, c(10, 16, 22, 58)])
HEXACO_example_data$C_SUM = rowSums(HEXACO_example_data[, c(3, 9, 39, 51)]) + 36 - rowSums(HEXACO_example_data[, c(15, 21, 27, 33, 45, 57)])
HEXACO_example_data$O_SUM = rowSums(HEXACO_example_data[, c(8, 14, 26, 38, 44)]) + 30 - rowSums(HEXACO_example_data[, c(2, 20, 32, 50, 56)])
cor(HEXACO_example_data$H_SUM[HEXACO_example_data$Group == "FC1"], tirt_lavaan_scores$honestyhumility)
#> [1] 0.6429388
cor(HEXACO_example_data$E_SUM[HEXACO_example_data$Group == "FC1"], tirt_lavaan_scores$emotionality)
#> [1] 0.7533617
cor(HEXACO_example_data$X_SUM[HEXACO_example_data$Group == "FC1"], tirt_lavaan_scores$extraversion)
#> [1] 0.7214019
cor(HEXACO_example_data$A_SUM[HEXACO_example_data$Group == "FC1"], tirt_lavaan_scores$agreeableness)
#> [1] 0.7317067
cor(HEXACO_example_data$C_SUM[HEXACO_example_data$Group == "FC1"], tirt_lavaan_scores$conscientiousness)
#> [1] 0.5203044
cor(HEXACO_example_data$O_SUM[HEXACO_example_data$Group == "FC1"], tirt_lavaan_scores$openness)
#> [1] 0.7631631
cor(HEXACO_example_data$H_SUM[HEXACO_example_data$Group == "FC1"], tirt_stan_scores$honestyhumility)
#> [1] 0.6516544
cor(HEXACO_example_data$E_SUM[HEXACO_example_data$Group == "FC1"], tirt_stan_scores$emotionality)
#> [1] 0.7986765
cor(HEXACO_example_data$X_SUM[HEXACO_example_data$Group == "FC1"], tirt_stan_scores$extraversion)
#> [1] 0.6662639
cor(HEXACO_example_data$A_SUM[HEXACO_example_data$Group == "FC1"], tirt_stan_scores$agreeableness)
#> [1] 0.7281868
cor(HEXACO_example_data$C_SUM[HEXACO_example_data$Group == "FC1"], tirt_stan_scores$conscientiousness)
#> [1] 0.5197408
cor(HEXACO_example_data$O_SUM[HEXACO_example_data$Group == "FC1"], tirt_stan_scores$openness)
#> [1] 0.7722533
cor(HEXACO_example_data$H_SUM[HEXACO_example_data$Group == "FC1"], ipsative_scores$honestyhumility)
#> [1] 0.6516462
cor(HEXACO_example_data$E_SUM[HEXACO_example_data$Group == "FC1"], ipsative_scores$emotionality)
#> [1] 0.8028248
cor(HEXACO_example_data$X_SUM[HEXACO_example_data$Group == "FC1"], ipsative_scores$extraversion)
#> [1] 0.7440281
cor(HEXACO_example_data$A_SUM[HEXACO_example_data$Group == "FC1"], ipsative_scores$agreeableness)
#> [1] 0.7444856
cor(HEXACO_example_data$C_SUM[HEXACO_example_data$Group == "FC1"], ipsative_scores$conscientiousness)
#> [1] 0.6368729
cor(HEXACO_example_data$O_SUM[HEXACO_example_data$Group == "FC1"], ipsative_scores$openness)
#> [1] 0.7825563