library(here)        # for file directory
library(tidyr)       # for pivot_wider
library(rio)         # to load in data
library(dplyr)       # general wrangling
library(brms)        # longitudinal similarity
library(rempsyc)     # simple slopes analysis
library(Hmisc)       # correlation matrix
library(psych)       # fisher's z transformation
library(lme4)        # linear mixed model   
library(lmerTest)    # linear mixed model significance test
library(lavaan)      # RI-CLPM
library(semPlot)     # semPaths
library(kableExtra)  # for styling and scroll_box

# source the helper file
source("00_helpers.R")

options(digits = 3)

Meta Data

This is the analytic report for the Early Dating dataset.

# load in data
data_yw <- rio::import(paste0(here(), "/data/cleaned_data_yw.RDS"))

# example data
data_yw %>%
  arrange(couple) %>%
  head() %>% 
  knitr::kable(
    caption = "Example first 6 rows of the Early Dating dataset"
  ) %>% 
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
Example first 6 rows of the Early Dating dataset
couple time ethnic_black_2 ethnic_black_1 ethnic_asian_2 ethnic_asian_1 ethnic_white_2 ethnic_white_1 ethnic_hisp_2 ethnic_hisp_1 ethnic_other_2 ethnic_other_1 ethnic_other_txt_2 ethnic_other_txt_1 age_2 age_1 duration_2 duration_1 rela_status_2 rela_status_1 neuroticism_self_2 neuroticism_self_1 agreeableness_self_2 agreeableness_self_1 conscientiousness_self_2 conscientiousness_self_1 extraversion_self_2 extraversion_self_1 openness_self_2 openness_self_1 neuroticism_partner_2 neuroticism_partner_1 agreeableness_partner_2 agreeableness_partner_1 conscientiousness_partner_2 conscientiousness_partner_1 extraversion_partner_2 extraversion_partner_1 openness_partner_2 openness_partner_1 avoidance_2 avoidance_1 anxiety_2 anxiety_1 resp_2 resp_1 trust_2 trust_1 prqc_overall_2 prqc_overall_1
1 0 0 0 0 0 1 1 0 0 0 0 NA NA 23 21 13 13 1 1 1.75 2.70 4.45 4.10 4.40 3.45 3.45 3.20 3.90 4.05 1.75 2.12 4.88 3.62 3.62 3.88 3.25 3.38 3.38 3.00 4.50 2.88 1.33 3.11 8.72 8.17 5.88 5.41 7.00 7.00
1 8 0 0 0 0 1 1 0 0 0 0 NA NA 23 21 13 13 1 1 1.50 2.25 4.38 3.50 4.25 3.50 4.25 3.12 3.75 3.50 2.00 2.25 5.00 3.50 3.75 4.00 3.25 3.62 4.25 3.12 3.38 2.00 2.00 2.89 8.89 8.17 5.88 6.24 7.00 7.00
1 16 0 0 0 0 1 1 0 0 0 0 NA NA 23 21 13 13 1 1 2.00 3.38 4.75 3.50 4.38 3.75 4.00 3.25 3.62 3.25 2.00 2.25 5.00 3.62 3.50 3.50 3.38 3.25 4.50 3.00 3.00 3.25 1.89 2.56 8.89 7.89 6.06 6.35 7.00 6.50
2 0 0 0 0 1 1 0 0 0 0 0 NA NA 30 18 NA 8 1 1 3.30 3.50 3.75 4.50 3.00 3.45 4.15 3.20 4.00 3.60 3.62 3.38 2.75 3.12 3.00 3.62 2.88 3.62 3.38 3.00 5.88 4.38 4.89 4.44 6.72 5.28 3.88 3.94 5.00 5.00
3 0 0 0 0 0 1 1 0 0 0 0 NA NA 29 31 13 12 1 1 2.10 3.50 4.05 4.60 3.20 2.30 4.35 2.40 4.50 4.35 2.75 4.62 4.88 2.00 3.00 2.25 3.12 4.12 4.88 2.50 3.00 3.88 2.56 3.56 8.00 7.56 6.00 4.71 6.33 6.17
4 0 0 0 0 0 1 1 0 0 0 0 NA NA 22 18 7 7 1 1 2.50 3.30 3.55 4.05 3.20 3.30 3.95 3.35 4.20 4.00 2.50 3.62 4.12 3.88 3.75 2.50 3.75 2.88 4.12 3.50 3.00 2.88 2.56 4.78 8.67 7.33 6.24 4.88 7.00 6.67

Missingness Analysis

miss_analysis(ID = "couple", var = c("agreeableness_self_1", "agreeableness_self_2"), 
              var_demo = c(
                paste0(rep(c("ethnic_black_", "ethnic_asian_", "ethnic_white_", 
                             "ethnic_hisp_", "ethnic_other_"), each = 2), 
                       rep(c(1,2), times = 5)),
                "age_1", "age_2",
                "duration_1", "duration_2",
                paste0(rep(c("agreeableness_self_", "conscientiousness_self_", 
                             "extraversion_self_", "neuroticism_self_", "openness_self_"), 
                           each = 2),
                       rep(c(1,2), times = 5))
              ),
              var_rela = 
                paste0(rep(c("prqc_overall_", "avoidance_", "anxiety_",
                             "resp_", "trust_"), each = 2),
                       rep(c(1,2), times = 5)),
              data = data_yw)
ethnic_black_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.07 0.362 -8.500 0.000
ethnic_black_1 -14.49 2284.102 -0.006 0.995
ethnic_black_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.06 0.362 -8.466 0.000
ethnic_black_2 -14.50 1769.258 -0.008 0.993
ethnic_asian_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.92 0.363 -8.058 0.000
ethnic_asian_1 -16.64 2069.611 -0.008 0.994
ethnic_asian_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.135 0.386 -8.121 0.000
ethnic_asian_2 0.427 1.103 0.388 0.698
ethnic_white_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.664 1.01 -3.618 0.000
ethnic_white_1 0.689 1.08 0.636 0.525
ethnic_white_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.862 0.727 -3.937 0.000
ethnic_white_2 -0.295 0.838 -0.352 0.725
ethnic_hisp_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.07 0.362 -8.500 0.000
ethnic_hisp_1 -14.49 2284.102 -0.006 0.995
ethnic_hisp_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.18 0.386 -8.26 0.000
ethnic_hisp_2 1.24 1.136 1.09 0.276
ethnic_other_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.01 0.362 -8.306 0.000
ethnic_other_1 -15.56 1743.249 -0.009 0.993
ethnic_other_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.03 0.362 -8.360 0.000
ethnic_other_2 -15.54 1966.650 -0.008 0.994
age_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -0.363 3.827 -0.095 0.924
age_1 -0.142 0.193 -0.737 0.461
age_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.695 3.463 0.201 0.841
age_2 -0.188 0.171 -1.103 0.270
duration_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.084 0.545 -5.661 0.000
duration_1 -0.014 0.043 -0.318 0.751
duration_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.904 0.744 -3.904 0.000
duration_2 -0.033 0.077 -0.434 0.664
agreeableness_self_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.839 3.410 -0.832 0.405
agreeableness_self_1 -0.097 0.856 -0.114 0.910
agreeableness_self_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -0.237 3.74 -0.063 0.950
agreeableness_self_2 -0.968 1.04 -0.930 0.352
conscientiousness_self_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -6.90 2.798 -2.46 0.014
conscientiousness_self_1 1.03 0.747 1.38 0.169
conscientiousness_self_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.394 2.967 0.133 0.894
conscientiousness_self_2 -1.325 0.979 -1.354 0.176
extraversion_self_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -6.623 2.949 -2.25 0.025
extraversion_self_1 0.892 0.743 1.20 0.230
extraversion_self_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -5.345 3.484 -1.535 0.125
extraversion_self_2 0.421 0.914 0.461 0.645
neuroticism_self_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -4.252 1.905 -2.232 0.026
neuroticism_self_1 0.347 0.617 0.562 0.574
neuroticism_self_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -4.674 2.214 -2.111 0.035
neuroticism_self_2 0.356 0.842 0.423 0.672
openness_self_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.408 2.603 -0.541 0.589
openness_self_1 -0.501 0.723 -0.693 0.488
openness_self_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -5.881 3.918 -1.50 0.133
openness_self_2 0.548 0.997 0.55 0.583
prqc_overall_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -7.422 4.573 -1.623 0.105
prqc_overall_1 0.659 0.702 0.939 0.348
prqc_overall_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -5.925 5.030 -1.178 0.239
prqc_overall_2 0.345 0.785 0.439 0.661
avoidance_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.59 1.345 -2.669 0.008
avoidance_1 0.11 0.378 0.292 0.770
avoidance_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.437 1.617 -0.889 0.374
avoidance_2 -0.825 0.618 -1.335 0.182
anxiety_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.483 1.261 -1.968 0.049
anxiety_1 -0.229 0.387 -0.592 0.554
anxiety_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -4.128 1.878 -2.198 0.028
anxiety_2 0.115 0.562 0.206 0.837
resp_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -5.478 3.230 -1.696 0.090
resp_1 0.296 0.412 0.718 0.473
resp_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -10.405 5.459 -1.91 0.057
resp_2 0.859 0.677 1.27 0.204
trust_1 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.980 2.521 -1.579 0.114
trust_1 0.143 0.466 0.308 0.758
trust_2 predicting missingness
Estimate Std. Error z value Pr(>|z|)
(Intercept) -5.348 3.67 -1.455 0.146
trust_2 0.305 0.68 0.448 0.654

Supplemental Analysis - Relationship Duration

These analyses examined whether relationship duration is associated with relationship quality

cor.test(data_yw[data_yw$time==0,]$prqc_overall_1, 
         data_yw[data_yw$time==0,]$duration_1)
## 
##  Pearson's product-moment correlation
## 
## data:  data_yw[data_yw$time == 0, ]$prqc_overall_1 and data_yw[data_yw$time == 0, ]$duration_1
## t = 1, df = 179, p-value = 0.2
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.0457  0.2431
## sample estimates:
##   cor 
## 0.101
cor.test(data_yw[data_yw$time==0,]$prqc_overall_2,
         data_yw[data_yw$time==0,]$duration_2)
## 
##  Pearson's product-moment correlation
## 
## data:  data_yw[data_yw$time == 0, ]$prqc_overall_2 and data_yw[data_yw$time == 0, ]$duration_2
## t = 0.6, df = 170, p-value = 0.6
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.107  0.192
## sample estimates:
##    cor 
## 0.0433

Research Question 1. Evidence of Assortative Mating

H1. Baseline similarity

At baseline, romantic partners are similar in their personality such that their scale scores are significantly and positively correlated

var_list <- c(
  # traits
  paste0(
    c("neuroticism", "agreeableness", "conscientiousness", "extraversion", "openness"),
    "_self"),
  
  # CA
  "avoidance", "anxiety", "resp", "trust",
  
  # relationship quality - not for hypothesis testing, just for slope later
  "prqc_overall"
)

prof_list <- data.frame(
  bigfive = paste0(
    c("neuroticism", "agreeableness", "conscientiousness", "extraversion", "openness"),
    "_self")
)

# run function for h1
h1_results <- h1_function(var_list = var_list, prof_list = prof_list, 
                          df = data_yw[which(data_yw$time == 0),], time = 0)

# results
h1_results$bivariate %>% 
  filter(variable != "prqc_overall") %>%
  knitr::kable(caption = "Bivariate between-partner correlation") %>% 
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
Bivariate between-partner correlation
variable n correlation p_value LL UL
neuroticism_self 179 0.069 0.362 -0.079 0.213
agreeableness_self 179 0.191 0.010 0.046 0.328
conscientiousness_self 179 0.155 0.039 0.008 0.295
extraversion_self 179 0.025 0.745 -0.123 0.171
openness_self 179 0.246 0.001 0.103 0.379
avoidance 174 0.074 0.329 -0.075 0.221
anxiety 174 0.153 0.043 0.005 0.295
resp 174 0.455 0.000 0.329 0.566
trust 171 0.236 0.002 0.089 0.373 
h1_results$profile %>% 
  knitr::kable(caption = "Proportion of signficant between-partner profile correlations in traits") %>% 
  kableExtra::kable_styling()
Proportion of signficant between-partner profile correlations in traits
time profile raw centered standardized
0 bigfive 0.15084 0.05028 0.05028 
data_yw <- merge(data_yw, h1_results$profile_df, all = TRUE)

summary(data_yw %>%
          filter(time == 0) %>%
          select(starts_with("bigfive"))) %>% 
  knitr::kable(caption = "Descriptive summary of trait profile correlations at baseline") %>% 
  kableExtra::kable_styling()
Descriptive summary of trait profile correlations at baseline
bigfive_raw_r bigfive_centered_r bigfive_std_r
Min. :-0.96 Min. :-0.99 Min. :-0.99
1st Qu.: 0.12 1st Qu.:-0.23 1st Qu.:-0.21
Median : 0.55 Median : 0.08 Median : 0.12
Mean : 0.39 Mean : 0.11 Mean : 0.12
3rd Qu.: 0.79 3rd Qu.: 0.55 3rd Qu.: 0.53
Max. : 0.98 Max. : 0.99 Max. : 0.96
NA’s :5 NA’s :5 NA’s :5

H2. Difference in correlations

At baseline, romantic partners are more similar in their characteristic adaptations than in their personality traits.

# run function on simulated data
h2_function(cor_tab = h1_results$bivariate) %>% 
  filter(V1 != "prqc_overall" & V2 != "prqc_overall") %>%
  arrange(desc(abs(z_stat))) %>%
  knitr::kable(caption = "Comparisons of bivariate correlations of personality traits vs CAs") %>% 
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
Comparisons of bivariate correlations of personality traits vs CAs
V1 V2 V1_cor V2_cor z_stat sig
extraversion_self resp 0.025 [-0.123 - 0.171] 0.455 [0.329 - 0.566] -4.340 TRUE
neuroticism_self resp 0.069 [-0.079 - 0.213] 0.455 [0.329 - 0.566] -3.929 TRUE
avoidance resp 0.074 [-0.075 - 0.221] 0.455 [0.329 - 0.566] -3.854 TRUE
conscientiousness_self resp 0.155 [0.008 - 0.295] 0.455 [0.329 - 0.566] -3.117 TRUE
anxiety resp 0.153 [0.005 - 0.295] 0.455 [0.329 - 0.566] -3.114 TRUE
agreeableness_self resp 0.191 [0.046 - 0.328] 0.455 [0.329 - 0.566] -2.772 TRUE
resp trust 0.455 [0.329 - 0.566] 0.236 [0.089 - 0.373] 2.306 TRUE
openness_self resp 0.246 [0.103 - 0.379] 0.455 [0.329 - 0.566] -2.234 TRUE
extraversion_self openness_self 0.025 [-0.123 - 0.171] 0.246 [0.103 - 0.379] -2.121 TRUE
extraversion_self trust 0.025 [-0.123 - 0.171] 0.236 [0.089 - 0.373] -1.998 TRUE
neuroticism_self openness_self 0.069 [-0.079 - 0.213] 0.246 [0.103 - 0.379] -1.708 FALSE
openness_self avoidance 0.246 [0.103 - 0.379] 0.074 [-0.075 - 0.221] 1.649 FALSE
neuroticism_self trust 0.069 [-0.079 - 0.213] 0.236 [0.089 - 0.373] -1.589 FALSE
agreeableness_self extraversion_self 0.191 [0.046 - 0.328] 0.025 [-0.123 - 0.171] 1.579 FALSE
avoidance trust 0.074 [-0.075 - 0.221] 0.236 [0.089 - 0.373] -1.532 FALSE
conscientiousness_self extraversion_self 0.155 [0.008 - 0.295] 0.025 [-0.123 - 0.171] 1.231 FALSE
extraversion_self anxiety 0.025 [-0.123 - 0.171] 0.153 [0.005 - 0.295] -1.203 FALSE
neuroticism_self agreeableness_self 0.069 [-0.079 - 0.213] 0.191 [0.046 - 0.328] -1.166 FALSE
agreeableness_self avoidance 0.191 [0.046 - 0.328] 0.074 [-0.075 - 0.221] 1.110 FALSE
openness_self anxiety 0.246 [0.103 - 0.379] 0.153 [0.005 - 0.295] 0.903 FALSE
conscientiousness_self openness_self 0.155 [0.008 - 0.295] 0.246 [0.103 - 0.379] -0.890 FALSE
neuroticism_self conscientiousness_self 0.069 [-0.079 - 0.213] 0.155 [0.008 - 0.295] -0.818 FALSE
anxiety trust 0.153 [0.005 - 0.295] 0.236 [0.089 - 0.373] -0.795 FALSE
neuroticism_self anxiety 0.069 [-0.079 - 0.213] 0.153 [0.005 - 0.295] -0.793 FALSE
conscientiousness_self trust 0.155 [0.008 - 0.295] 0.236 [0.089 - 0.373] -0.781 FALSE
conscientiousness_self avoidance 0.155 [0.008 - 0.295] 0.074 [-0.075 - 0.221] 0.765 FALSE
avoidance anxiety 0.074 [-0.075 - 0.221] 0.153 [0.005 - 0.295] -0.740 FALSE
agreeableness_self openness_self 0.191 [0.046 - 0.328] 0.246 [0.103 - 0.379] -0.542 FALSE
extraversion_self avoidance 0.025 [-0.123 - 0.171] 0.074 [-0.075 - 0.221] -0.458 FALSE
agreeableness_self trust 0.191 [0.046 - 0.328] 0.236 [0.089 - 0.373] -0.437 FALSE
neuroticism_self extraversion_self 0.069 [-0.079 - 0.213] 0.025 [-0.123 - 0.171] 0.414 FALSE
agreeableness_self anxiety 0.191 [0.046 - 0.328] 0.153 [0.005 - 0.295] 0.365 FALSE
agreeableness_self conscientiousness_self 0.191 [0.046 - 0.328] 0.155 [0.008 - 0.295] 0.348 FALSE
openness_self trust 0.246 [0.103 - 0.379] 0.236 [0.089 - 0.373] 0.098 FALSE
neuroticism_self avoidance 0.069 [-0.079 - 0.213] 0.074 [-0.075 - 0.221] -0.047 FALSE
conscientiousness_self anxiety 0.155 [0.008 - 0.295] 0.153 [0.005 - 0.295] 0.019 FALSE

H3. Longitudinal similarity

Longitudinally, romantic partners show a similar change trajectory in self-reported personality across the study duration such that their slopes are significantly and positively correlated.

var_list <- c(
  paste0(
    c("agreeableness", "conscientiousness", "extraversion", "openness", "neuroticism"),
    rep(c("_self", "_partner"), each = 5)),
  "avoidance", "anxiety", "resp", "trust",
  "prqc_overall"
)

# run function
h3_results <- h3_function(var_list = var_list, df = data_yw,
                          dir = paste0(here(), "/results/yw/brm"))

# view longitudinal trends
h3_results$slopes_tab %>% 
  knitr::kable(caption = "Longitudinal trends in all variables") %>% 
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
Longitudinal trends in all variables
gender Estimate Est.Error l-95% CI u-95% CI
agreeablenessself1_time female -0.006 0.003 -0.013 0.001
agreeablenessself2_time male -0.003 0.003 -0.009 0.003
conscientiousnessself1_time female 0.002 0.003 -0.004 0.009
conscientiousnessself2_time male 0.003 0.003 -0.003 0.009
extraversionself1_time female -0.002 0.004 -0.009 0.006
extraversionself2_time male -0.001 0.003 -0.007 0.006
opennessself1_time female -0.009 0.004 -0.016 -0.002
opennessself2_time male -0.015 0.003 -0.021 -0.008
neuroticismself1_time female -0.001 0.005 -0.010 0.009
neuroticismself2_time male 0.003 0.004 -0.005 0.011
agreeablenesspartner1_time female -0.007 0.004 -0.015 0.001
agreeablenesspartner2_time male -0.007 0.004 -0.015 0.001
conscientiousnesspartner1_time female -0.005 0.004 -0.012 0.003
conscientiousnesspartner2_time male -0.006 0.004 -0.014 0.001
extraversionpartner1_time female -0.003 0.004 -0.010 0.005
extraversionpartner2_time male -0.001 0.003 -0.007 0.006
opennesspartner1_time female 0.000 0.004 -0.008 0.007
opennesspartner2_time male -0.010 0.004 -0.018 -0.001
neuroticismpartner1_time female -0.004 0.005 -0.013 0.006
neuroticismpartner2_time male 0.000 0.004 -0.008 0.009
avoidance1_time female -0.006 0.006 -0.018 0.006
avoidance2_time male 0.004 0.005 -0.006 0.015
anxiety1_time female -0.012 0.006 -0.025 0.000
anxiety2_time male 0.006 0.006 -0.005 0.018
resp1_time female -0.005 0.007 -0.019 0.009
resp2_time male -0.011 0.008 -0.027 0.003
trust1_time female 0.005 0.005 -0.004 0.015
trust2_time male -0.003 0.006 -0.014 0.007
prqcoverall1_time female -0.015 0.006 -0.026 -0.004
prqcoverall2_time male -0.021 0.006 -0.033 -0.009 
# view longitudinal similarity 
h3_results$results_df %>% 
  knitr::kable(caption = "Bivariate between-partner slope correlations") %>% 
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
Bivariate between-partner slope correlations
Estimate Est.Error l-95% CI u-95% CI
rescor(agreeablenessself1,agreeablenessself2) -0.008 0.077 -0.152 0.141
rescor(conscientiousnessself1,conscientiousnessself2) 0.093 0.080 -0.061 0.247
rescor(extraversionself1,extraversionself2) 0.003 0.076 -0.146 0.157
rescor(opennessself1,opennessself2) 0.127 0.077 -0.024 0.279
rescor(neuroticismself1,neuroticismself2) -0.017 0.075 -0.163 0.130
rescor(agreeablenesspartner1,agreeablenesspartner2) 0.083 0.076 -0.069 0.229
rescor(conscientiousnesspartner1,conscientiousnesspartner2) 0.047 0.084 -0.118 0.208
rescor(extraversionpartner1,extraversionpartner2) 0.024 0.075 -0.122 0.172
rescor(opennesspartner1,opennesspartner2) 0.085 0.094 -0.102 0.269
rescor(neuroticismpartner1,neuroticismpartner2) 0.110 0.076 -0.040 0.262
rescor(avoidance1,avoidance2) 0.172 0.086 0.003 0.336
rescor(anxiety1,anxiety2) 0.114 0.075 -0.032 0.266
rescor(resp1,resp2) 0.276 0.075 0.124 0.420
rescor(trust1,trust2) -0.126 0.084 -0.289 0.035
rescor(prqcoverall1,prqcoverall2) 0.395 0.070 0.255 0.527 
# merge slope data to original dataframe
slope_df <- h3_results$slope_df %>%
  mutate(time = 0)
data_yw <- merge(data_yw,
                 slope_df,
                 all = T)

H4. Perceived/actual similarity comparison

At baseline, perceived similarity in personality traits and characteristic adaptations is stronger than actual similarity. That is, the correlation between each partner’s self-perception and perception of their partner is stronger than the correlation between two partners’ self-perceptions.

perception_list <- c("neuroticism", "agreeableness", "conscientiousness", "extraversion", "openness")

# run function
h4_results <- h4_function(perception_list = perception_list,
                          time = 0, df = data_yw)

h4_results$similarity_df %>%
  knitr::kable(
    caption = "Actual and perceived similarities as bivariate correlations") %>%
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
Actual and perceived similarities as bivariate correlations
similarity personality correlation p-value
actual neuroticism 0.069 [-0.079 - 0.213] 0.362
female-perceived neuroticism 0.151 [0.006 - 0.29] 0.042
male-perceived neuroticism 0.119 [-0.03 - 0.263] 0.116
actual agreeableness 0.191 [0.046 - 0.328] 0.01
female-perceived agreeableness 0.33 [0.194 - 0.454] 0
male-perceived agreeableness 0.338 [0.199 - 0.463] 0
actual conscientiousness 0.155 [0.008 - 0.295] 0.039
female-perceived conscientiousness 0.217 [0.074 - 0.352] 0.003
male-perceived conscientiousness 0.034 [-0.115 - 0.181] 0.657
actual extraversion 0.025 [-0.123 - 0.171] 0.745
female-perceived extraversion 0.171 [0.026 - 0.309] 0.021
male-perceived extraversion 0.119 [-0.029 - 0.263] 0.115
actual openness 0.246 [0.103 - 0.379] 0.001
female-perceived openness 0.375 [0.243 - 0.494] 0
male-perceived openness 0.499 [0.379 - 0.603] 0 
h4_results$compare_df %>%
  knitr::kable(
    caption = "Comparison between actual and perceived similarities") %>%
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
Comparison between actual and perceived similarities
V1 V2 personality z_stat sig
actual female-perceived neuroticism -0.789 FALSE
actual male-perceived neuroticism -0.478 FALSE
female-perceived male-perceived neuroticism 0.304 FALSE
actual female-perceived agreeableness -1.411 FALSE
actual male-perceived agreeableness -1.476 FALSE
female-perceived male-perceived agreeableness -0.079 FALSE
actual female-perceived conscientiousness -0.610 FALSE
actual male-perceived conscientiousness 1.140 FALSE
female-perceived male-perceived conscientiousness 1.750 FALSE
actual female-perceived extraversion -1.398 FALSE
actual male-perceived extraversion -0.891 FALSE
female-perceived male-perceived extraversion 0.495 FALSE
actual female-perceived openness -1.354 FALSE
actual male-perceived openness -2.775 TRUE
female-perceived male-perceived openness -1.440 FALSE

Research Question 2. Benefit of Assortative Mating

H5. Baseline benefit

At baseline, partner similarity in self-reported personality is associated with enhanced relationship quality.

var_list <- c(
  # traits
  paste0(
    c("neuroticism", "agreeableness", "conscientiousness", "extraversion", "openness"),
    "_self"),
  # CA
  "avoidance", "anxiety", "resp", "trust"
)
quality_list <- "prqc_overall"

# run function
drsa_results <- drsa_function(var_list = var_list,
                              quality_list = quality_list,
                              dir = paste0(here(), "/results/yw/drsa"),
                              df = data_yw)

# output results
drsa_results$est_df %>% 
  mutate(across(is.numeric, round, digits=2)) %>%
  knitr::kable(caption = "All estimates for DRSA auxiliary parameters") %>% 
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
All estimates for DRSA auxiliary parameters
predictor outcome label est.std se pvalue ci.lower ci.upper
neuroticism_self prqc_overall a1f -0.30 0.09 0.00 -0.48 -0.12
neuroticism_self prqc_overall a2f -0.20 0.12 0.09 -0.43 0.03
neuroticism_self prqc_overall a3f -0.10 0.06 0.11 -0.22 0.02
neuroticism_self prqc_overall a4f -0.12 0.12 0.32 -0.36 0.12
neuroticism_self prqc_overall a5f 0.09 0.08 0.29 -0.07 0.25
agreeableness_self prqc_overall a1f 0.24 0.09 0.01 0.05 0.42
agreeableness_self prqc_overall a2f 0.01 0.14 0.92 -0.26 0.28
agreeableness_self prqc_overall a3f 0.15 0.15 0.31 -0.14 0.45
agreeableness_self prqc_overall a4f -0.16 0.19 0.39 -0.53 0.21
agreeableness_self prqc_overall a5f -0.14 0.13 0.27 -0.39 0.11
agreeableness_self prqc_overall a1m 0.30 0.09 0.00 0.13 0.48
agreeableness_self prqc_overall a2m -0.37 0.13 0.01 -0.63 -0.11
agreeableness_self prqc_overall a3m -0.30 0.10 0.00 -0.50 -0.10
agreeableness_self prqc_overall a4m 0.00 0.18 1.00 -0.35 0.35
agreeableness_self prqc_overall a5m -0.19 0.12 0.10 -0.42 0.04
conscientiousness_self prqc_overall a1f 0.16 0.07 0.03 0.01 0.30
conscientiousness_self prqc_overall a2f 0.08 0.08 0.34 -0.09 0.25
conscientiousness_self prqc_overall a3f 0.06 0.05 0.21 -0.04 0.16
conscientiousness_self prqc_overall a4f 0.16 0.09 0.06 0.00 0.33
conscientiousness_self prqc_overall a5f 0.01 0.05 0.85 -0.09 0.10
extraversion_self prqc_overall a1f 0.33 0.08 0.00 0.17 0.49
extraversion_self prqc_overall a2f -0.10 0.11 0.38 -0.32 0.12
extraversion_self prqc_overall a3f 0.10 0.06 0.09 -0.02 0.23
extraversion_self prqc_overall a4f -0.04 0.12 0.74 -0.27 0.20
extraversion_self prqc_overall a5f 0.05 0.07 0.42 -0.07 0.18
openness_self prqc_overall a1f 0.19 0.08 0.02 0.03 0.35
openness_self prqc_overall a2f 0.12 0.09 0.20 -0.06 0.30
openness_self prqc_overall a3f 0.05 0.07 0.52 -0.10 0.19
openness_self prqc_overall a4f -0.01 0.13 0.93 -0.27 0.25
openness_self prqc_overall a5f -0.01 0.07 0.93 -0.13 0.12
avoidance prqc_overall a1f -0.41 0.07 0.00 -0.55 -0.26
avoidance prqc_overall a2f -0.18 0.12 0.15 -0.42 0.06
avoidance prqc_overall a3f -0.22 0.06 0.00 -0.34 -0.11
avoidance prqc_overall a4f -0.11 0.12 0.32 -0.34 0.11
avoidance prqc_overall a5f 0.11 0.06 0.06 0.00 0.22
anxiety prqc_overall a1f -0.52 0.07 0.00 -0.65 -0.39
anxiety prqc_overall a2f -0.05 0.14 0.72 -0.32 0.22
anxiety prqc_overall a3f -0.18 0.07 0.01 -0.31 -0.04
anxiety prqc_overall a4f -0.16 0.21 0.44 -0.57 0.25
anxiety prqc_overall a5f 0.00 0.10 0.97 -0.19 0.20
resp prqc_overall a1f 0.65 0.09 0.00 0.48 0.82
resp prqc_overall a2f -0.02 0.16 0.91 -0.33 0.29
resp prqc_overall a3f 0.50 0.17 0.00 0.16 0.84
resp prqc_overall a4f -0.23 0.19 0.24 -0.61 0.15
resp prqc_overall a5f -0.28 0.16 0.08 -0.60 0.04
resp prqc_overall a1m 0.75 0.08 0.00 0.60 0.91
resp prqc_overall a2m 0.06 0.13 0.66 -0.20 0.31
resp prqc_overall a3m -0.55 0.12 0.00 -0.78 -0.33
resp prqc_overall a4m -0.13 0.32 0.68 -0.76 0.49
resp prqc_overall a5m -0.27 0.12 0.03 -0.51 -0.03
trust prqc_overall a1f 0.58 0.06 0.00 0.46 0.70
trust prqc_overall a2f -0.03 0.13 0.80 -0.30 0.23
trust prqc_overall a3f 0.30 0.07 0.00 0.16 0.43
trust prqc_overall a4f 0.10 0.13 0.46 -0.16 0.35
trust prqc_overall a5f -0.08 0.07 0.26 -0.22 0.06 
drsa_results$results_df %>% 
  knitr::kable(caption = "DRSA congruence results") %>% 
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
DRSA congruence results
predictor outcome model sex actor_partner broad_congruence strict_congruence
neuroticism_self prqc_overall reduced NA TRUE FALSE FALSE
agreeableness_self prqc_overall full female TRUE FALSE FALSE
agreeableness_self prqc_overall full male TRUE FALSE FALSE
conscientiousness_self prqc_overall reduced NA TRUE FALSE FALSE
extraversion_self prqc_overall reduced NA TRUE FALSE FALSE
openness_self prqc_overall reduced NA TRUE FALSE FALSE
avoidance prqc_overall reduced NA TRUE FALSE FALSE
anxiety prqc_overall reduced NA TRUE FALSE FALSE
resp prqc_overall full female TRUE FALSE FALSE
resp prqc_overall full male TRUE FALSE FALSE
trust prqc_overall reduced NA TRUE FALSE FALSE

H6. Longitudinal benefit

Longitudinally, partner similarity in change trajectories of self-reported personality is associated with higher average relationship quality

# create dataframe of average relationship quality across time
data_yw_drsalong <- data_yw %>%
  group_by(couple) %>%
  mutate(prqc_overall_avg_1 = mean(prqc_overall_1, na.rm=T),
         prqc_overall_avg_2 = mean(prqc_overall_2, na.rm=T)) %>%
  ungroup() %>%
  filter(time == 0)

# params for longitudinal drsa models
var_list <- c(
  # traits
  paste0(
    "slope_",
    c("neuroticism", "agreeableness", "conscientiousness", "extraversion", "openness"),
    "_self"),
  # CA
  paste0("slope_", c("avoidance", "anxiety", "resp", "trust"))
)
quality_list <- "prqc_overall_avg"

# run function
drsa_long_results <- drsa_function(var_list = var_list,
                                   quality_list = quality_list,
                                   dir = paste0(here(), "/results/yw/drsa_long"),
                                   df = data_yw_drsalong,
                                   scale = T)

# output results
drsa_long_results$est_df %>% 
  mutate(across(is.numeric, round, digits=2)) %>%
  knitr::kable(caption = "All estimates for DRSA auxiliary parameters") %>% 
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
All estimates for DRSA auxiliary parameters
predictor outcome label est.std se pvalue ci.lower ci.upper
slope_neuroticism_self prqc_overall_avg a1f -0.38 0.08 0.00 -0.55 -0.22
slope_neuroticism_self prqc_overall_avg a2f -0.01 0.10 0.92 -0.21 0.19
slope_neuroticism_self prqc_overall_avg a3f -0.15 0.12 0.23 -0.39 0.09
slope_neuroticism_self prqc_overall_avg a4f 0.16 0.14 0.26 -0.12 0.43
slope_neuroticism_self prqc_overall_avg a5f -0.20 0.10 0.05 -0.39 0.00
slope_neuroticism_self prqc_overall_avg a1m -0.57 0.09 0.00 -0.74 -0.39
slope_neuroticism_self prqc_overall_avg a2m -0.28 0.10 0.00 -0.47 -0.09
slope_neuroticism_self prqc_overall_avg a3m 0.12 0.08 0.14 -0.04 0.27
slope_neuroticism_self prqc_overall_avg a4m 0.25 0.09 0.00 0.08 0.42
slope_neuroticism_self prqc_overall_avg a5m -0.03 0.14 0.81 -0.32 0.25
slope_agreeableness_self prqc_overall_avg a1f 0.37 0.09 0.00 0.18 0.55
slope_agreeableness_self prqc_overall_avg a2f -0.07 0.17 0.68 -0.40 0.26
slope_agreeableness_self prqc_overall_avg a3f 0.18 0.07 0.01 0.05 0.31
slope_agreeableness_self prqc_overall_avg a4f 0.14 0.13 0.27 -0.11 0.40
slope_agreeableness_self prqc_overall_avg a5f -0.07 0.08 0.38 -0.22 0.08
slope_conscientiousness_self prqc_overall_avg a1f -0.04 0.12 0.76 -0.27 0.20
slope_conscientiousness_self prqc_overall_avg a2f -0.04 0.13 0.74 -0.29 0.21
slope_conscientiousness_self prqc_overall_avg a3f 0.07 0.05 0.18 -0.03 0.18
slope_conscientiousness_self prqc_overall_avg a4f 0.11 0.11 0.29 -0.09 0.32
slope_conscientiousness_self prqc_overall_avg a5f -0.07 0.06 0.25 -0.20 0.05
slope_extraversion_self prqc_overall_avg a1f -0.33 0.09 0.00 -0.51 -0.15
slope_extraversion_self prqc_overall_avg a2f -0.01 0.13 0.92 -0.28 0.25
slope_extraversion_self prqc_overall_avg a3f -0.07 0.06 0.18 -0.18 0.04
slope_extraversion_self prqc_overall_avg a4f 0.07 0.09 0.43 -0.11 0.25
slope_extraversion_self prqc_overall_avg a5f 0.04 0.06 0.53 -0.08 0.15
slope_openness_self prqc_overall_avg a1f 0.31 0.07 0.00 0.17 0.45
slope_openness_self prqc_overall_avg a2f -0.03 0.08 0.70 -0.18 0.12
slope_openness_self prqc_overall_avg a3f 0.10 0.08 0.22 -0.06 0.26
slope_openness_self prqc_overall_avg a4f -0.20 0.15 0.18 -0.49 0.09
slope_openness_self prqc_overall_avg a5f -0.08 0.07 0.28 -0.22 0.06
slope_avoidance prqc_overall_avg a1f 0.10 0.15 0.49 -0.18 0.39
slope_avoidance prqc_overall_avg a2f -0.03 0.22 0.89 -0.46 0.40
slope_avoidance prqc_overall_avg a3f -0.08 0.10 0.45 -0.27 0.12
slope_avoidance prqc_overall_avg a4f 0.03 0.12 0.81 -0.20 0.26
slope_avoidance prqc_overall_avg a5f 0.10 0.11 0.36 -0.12 0.33
slope_avoidance prqc_overall_avg a1m 0.38 0.12 0.00 0.14 0.62
slope_avoidance prqc_overall_avg a2m -0.28 0.22 0.20 -0.72 0.15
slope_avoidance prqc_overall_avg a3m -0.16 0.11 0.12 -0.37 0.04
slope_avoidance prqc_overall_avg a4m -0.20 0.15 0.17 -0.49 0.09
slope_avoidance prqc_overall_avg a5m -0.07 0.11 0.52 -0.28 0.14
slope_anxiety prqc_overall_avg a1f -0.66 0.08 0.00 -0.81 -0.51
slope_anxiety prqc_overall_avg a2f -0.15 0.10 0.14 -0.35 0.05
slope_anxiety prqc_overall_avg a3f -0.07 0.07 0.30 -0.21 0.06
slope_anxiety prqc_overall_avg a4f 0.09 0.11 0.43 -0.13 0.31
slope_anxiety prqc_overall_avg a5f 0.06 0.05 0.28 -0.05 0.16
slope_resp prqc_overall_avg a1f 0.79 0.06 0.00 0.68 0.91
slope_resp prqc_overall_avg a2f -0.07 0.08 0.40 -0.22 0.09
slope_resp prqc_overall_avg a3f 0.54 0.07 0.00 0.41 0.68
slope_resp prqc_overall_avg a4f -0.23 0.19 0.23 -0.61 0.15
slope_resp prqc_overall_avg a5f 0.04 0.08 0.63 -0.11 0.19
slope_trust prqc_overall_avg a1f 0.57 0.07 0.00 0.44 0.70
slope_trust prqc_overall_avg a2f 0.00 0.09 0.96 -0.18 0.19
slope_trust prqc_overall_avg a3f 0.27 0.06 0.00 0.15 0.38
slope_trust prqc_overall_avg a4f 0.12 0.20 0.55 -0.28 0.52
slope_trust prqc_overall_avg a5f 0.04 0.08 0.59 -0.11 0.19 
drsa_long_results$results_df %>% 
  knitr::kable(caption = "DRSA congruence results") %>% 
  kableExtra::kable_styling() %>%
  scroll_box(height = "300px")
DRSA congruence results
predictor outcome model sex actor_partner broad_congruence strict_congruence
slope_neuroticism_self prqc_overall_avg full female TRUE FALSE FALSE
slope_neuroticism_self prqc_overall_avg full male TRUE FALSE FALSE
slope_agreeableness_self prqc_overall_avg reduced NA TRUE FALSE FALSE
slope_conscientiousness_self prqc_overall_avg reduced NA FALSE FALSE FALSE
slope_extraversion_self prqc_overall_avg reduced NA TRUE FALSE FALSE
slope_openness_self prqc_overall_avg reduced NA TRUE FALSE FALSE
slope_avoidance prqc_overall_avg full female FALSE FALSE FALSE
slope_avoidance prqc_overall_avg full male TRUE FALSE FALSE
slope_anxiety prqc_overall_avg reduced NA TRUE FALSE FALSE
slope_resp prqc_overall_avg reduced NA TRUE FALSE FALSE
slope_trust prqc_overall_avg reduced NA TRUE FALSE FALSE