Files

compersion_m <- readRDS(file = "compersion_m.rds") # metamour-level data
compersion_p <- readRDS(file = "compersion_p.rds") # partner-level data
compersion <- readRDS(file = "compersion_participant.rds") # participant-level data

Libraries used

library(tidyverse)
library(kableExtra) # for printing tables
library(skimr) # for summarizing variables with skim()
library(moments) # for skewness()
library(lme4) # for multilevel models
library(lmerTest) # for p-values in lmer
library(sjstats) # for ICC 
library(emmeans) # for means in multilevel models

Sample characteristics

Age

compersion |> 
  summarize(M = round(mean(age, na.rm = T), 2),
            Mdn = median(age, na.rm = T),
            SD = round(sd(age, na.rm = T), 2),
            missing = sum(is.na(age))
            ) |> 
  kbl() |> kable_styling()
M Mdn SD missing
38.25 37 10.79 1

Gender

# Counts and proportions
aux1 <- compersion |> 
  group_by(gender) |> 
  summarize(n = n()) |> 
  mutate(`prop (%)` = round(100*n/sum(n), 1)) 

# Means and SDs for compersion subscales
aux2 <- compersion_m |> 
  pivot_longer(c(EM, SA, NC),
               names_to = "subscale", 
               values_to = "value") |> 
  mutate(subscale = factor(subscale, levels = c("EM", "SA", "NC"))) |> 
  group_by(subscale, gender) |> 
  summarize(M = round(mean(value, na.rm = T), 2),
            SD = round(sd(value, na.rm = T), 2)) |> 
  pivot_wider(names_from = subscale, values_from = c(M, SD), names_vary = "slowest") |> 
  dplyr::select(-gender)
aux2[nrow(aux2),] <- NA

# Print summary table
bind_cols(aux1, aux2) |> 
  kbl() |> kable_styling()
gender n prop (%) M_EM SD_EM M_SA SD_SA M_NC SD_NC
Woman 142 55.7 3.85 1.22 1.83 1.14 3.06 1.37
Man 68 26.7 4.04 1.06 2.21 1.45 3.36 1.21
Non-binary 43 16.9 3.57 1.27 1.61 1.00 3.27 1.07
NA 2 0.8 NA NA NA NA NA NA

Transgender

1 = transgender, 0 = not transgender

# Counts and proportions
aux1 <- compersion |> 
  group_by(trans) |> 
  summarize(n = n()) |> 
  mutate(`prop (%)` = round(100*n/sum(n), 1))

# Means and SDs for compersion subscales
aux2 <- compersion_m |> 
  pivot_longer(c(EM, SA, NC),
               names_to = "subscale", 
               values_to = "value") |> 
  mutate(subscale = factor(subscale, levels = c("EM", "SA", "NC"))) |> 
  group_by(subscale, trans) |> 
  summarize(M = round(mean(value, na.rm = T), 2),
            SD = round(sd(value, na.rm = T), 2)) |> 
  pivot_wider(names_from = subscale, values_from = c(M, SD), names_vary = "slowest") |> 
  dplyr::select(-trans)
aux2[nrow(aux2),] <- NA

# Print summary table
bind_cols(aux1, aux2) |> 
  kbl() |> kable_styling()
trans n prop (%) M_EM SD_EM M_SA SD_SA M_NC SD_NC
0 219 85.9 3.84 1.19 1.89 1.23 3.11 1.31
1 35 13.7 3.93 1.20 1.92 1.17 3.58 1.10
NA 1 0.4 NA NA NA NA NA NA

Sexual orientation

Participants may identify with more than one orientation, for instance:

compersion$Q77[1:5]
## [1] "Pansexual"                             
## [2] "Heterosexual,Pansexual"                
## [3] "Bisexual,Pansexual"                    
## [4] "Bisexual,Sexually Fluid,Something else"
## [5] "Bisexual,Pansexual"

Placing each identification in its own cell:

nr <- nrow(compersion)
df_orientation <- data.frame(
  participant = NA, orientation = NA, 
  EM_p1m1 = NA, EM_p1m2 = NA, EM_p2m1 = NA, EM_p2m2 = NA,
  SA_p1m1 = NA, SA_p1m2 = NA, SA_p2m1 = NA, SA_p2m2 = NA,
  NC_p1 = NA, NC_p2 = NA
  )
for (i in 1:nr) {
  aux <- unlist(strsplit(compersion$Q77[i], ",", fixed = T))
  if (length(aux) > 0) { 
    df_orientation <- rbind(
      df_orientation, 
      data.frame(
        participant = i, orientation = aux,
        EM_p1m1 = compersion$EM_p1m1[i], EM_p1m2 = compersion$EM_p1m2[i], 
        EM_p2m1 = compersion$EM_p2m1[i], EM_p2m2 = compersion$EM_p2m2[i],
        SA_p1m1 = compersion$SA_p1m1[i], SA_p1m2 = compersion$SA_p1m2[i], 
        SA_p2m1 = compersion$SA_p2m1[i], SA_p2m2 = compersion$SA_p2m2[i],
        NC_p1 = compersion$NC_p1[i], NC_p2 = compersion$NC_p2[i]
        )
    )
  }
}
df_orientation <- df_orientation[-1,] |> 
  mutate(orientation = fct_relevel(fct_infreq(orientation), c("Something else", "Prefer not to answer"), after = Inf))
# Counts and proportions
aux1 <- df_orientation |> 
  group_by(orientation) |> 
  summarize(n = n()) |> 
  mutate(`prop (%)` = round(100*n/255, 1))

The 255 participants reported 370 orientations. Proportions are out of 255 participants and add to 145.1%.

sum(aux1$n, na.rm = T)
## [1] 370
sum(aux1$`prop (%)`, na.rm = T)
## [1] 145.1
# Means and SDs for compersion subscales
aux2 <- df_orientation |> 
  pivot_longer(c(-participant, -orientation),
               names_to = "subscale", 
               values_to = "value") |> 
  mutate(subscale = sub("\\_.*", "", subscale)) |> 
  mutate(subscale = factor(subscale, levels = c("EM", "SA", "NC"))) |> 
  group_by(subscale, orientation) |> 
  summarize(M = round(mean(value, na.rm = T), 2),
            SD = round(sd(value, na.rm = T), 2)) |> 
  pivot_wider(names_from = subscale, values_from = c(M, SD), names_vary = "slowest") |> 
  dplyr::select(-orientation)

# Print summary table
bind_cols(aux1, aux2) |> 
  kbl() |> kable_styling()
orientation n prop (%) M_EM SD_EM M_SA SD_SA M_NC SD_NC
Bisexual 111 43.5 3.83 1.25 1.94 1.24 3.22 1.30
Pansexual 82 32.2 3.91 1.19 1.85 1.14 3.45 1.27
Heterosexual 75 29.4 3.76 1.11 1.84 1.16 2.96 1.30
Sexually Fluid 34 13.3 4.03 1.09 1.97 1.20 3.36 1.29
Gay/Lesbian 20 7.8 4.05 1.12 2.27 1.50 3.29 1.27
Asexual 16 6.3 3.86 1.11 1.44 0.91 3.40 1.15
Something else 31 12.2 4.00 1.14 1.80 1.12 3.34 1.19
Prefer not to answer 1 0.4 4.40 NA 1.00 NA 2.67 NA

Race

Participants may identify more than one race/ethnicity. Placing each identification in its own cell:

# compersion$Q73 and compersion$Q75 text answers

nr <- nrow(compersion)
df <- data.frame(race1 = compersion$Q71, race2 = rep(NA, nr), race3 = rep(NA, nr), race4 = rep(NA, nr))
for (i in 1:nr) {
  aux <- unlist(strsplit(df$race1[i], ",", fixed = T))
  df[i, 1:length(aux)] <- aux
}
df[c(14,122,146,158,188,198,221,232,250),2] <- "Jewish"
df[c(53,212),1] <- "Jewish"
df[217,2] <- NA
compersion$race1 <- df$race1
compersion$race2 <- df$race2
compersion$race3 <- df$race3
compersion$race4 <- df$race4

df_race <- compersion |> 
  pivot_longer(c(race1, race2, race3, race4),
               names_to = "race_n", values_to = "race") |> 
  filter(race_n == "race1" | !is.na(race)) |> 
  dplyr::select(c(race, EM_p1m1, EM_p1m2, EM_p2m1, EM_p2m2, SA_p1m1, SA_p1m2, SA_p2m1, SA_p2m2, NC_p1, NC_p2)) |> 
  mutate(race = fct_relevel(fct_infreq(race), c("Something else", "Prefer not to answer"), after = Inf))
# Counts and proportions
aux1 <- df_race |> 
  group_by(race) |> 
  summarize(n = n()) |> 
  mutate(`prop (%)` = round(100*n/255, 1))

255 participants reported 295 race identifications. Proportions are out of 255 participants and add to 115.7%.

sum(aux1$n, na.rm = T)
## [1] 295
sum(aux1$`prop (%)`, na.rm = T)
## [1] 115.7
# Meand and SDs for compersion subscales
aux2 <- df_race |> 
  pivot_longer(-race,
               names_to = "subscale", 
               values_to = "value") |> 
  mutate(subscale = sub("\\_.*", "", subscale)) |> 
  mutate(subscale = factor(subscale, levels = c("EM", "SA", "NC"))) |> 
  group_by(subscale, race) |> 
  summarize(M = round(mean(value, na.rm = T), 2),
            SD = round(sd(value, na.rm = T), 2)) |> 
  pivot_wider(names_from = subscale, values_from = c(M, SD), names_vary = "slowest") |> 
  dplyr::select(-race)

# Print summary table
bind_cols(aux1, aux2) |> 
  kbl() |> kable_styling()
race n prop (%) M_EM SD_EM M_SA SD_SA M_NC SD_NC
White / European 237 92.9 3.87 1.18 1.88 1.22 3.19 1.30
Hispanic/ Latinx 16 6.3 3.63 1.32 2.47 1.53 3.22 1.22
Jewish 11 4.3 3.83 1.09 1.39 0.69 3.00 1.16
African/ Black 8 3.1 3.66 1.13 2.52 1.42 3.50 0.97
Native American / Alaskan Native / Indigenous / Aboriginal 7 2.7 3.51 1.43 1.90 1.50 3.44 0.99
Asian 6 2.4 3.58 1.35 1.44 0.91 2.30 1.36
Middle Eastern / North African 2 0.8 4.10 0.14 1.50 0.71 3.00 0.47
Native Hawaiian / Pacific Islander 1 0.4 4.60 NA 1.67 NA 3.00 NA
Something else 5 2.0 4.82 0.32 1.93 1.41 3.14 1.54
Prefer not to answer 2 0.8 4.60 0.28 1.00 0.00 3.50 1.18

Recruitment

compersion$Source[compersion$Source == ""] <- NA
summary(factor(compersion$Source))
##           CDAZ    CNMCommitte       listserv           NCSF        polyfam 
##             15             57             25             19              2 
## r/openmarriage    r/polyamory      r/polyfam        twitter           NA's 
##              7             71             44              6              9

Relationship type

# Counts and proportions
aux1 <- compersion_p |> 
  mutate(rel_type = fct_relevel(fct_infreq(rel_type), "Other", after = Inf)) |> 
  filter(!is.na(rel_type)) |> 
  group_by(rel_type) |> 
  summarize(n = n()) |> 
  mutate(`prop (%)` = round(100*n/sum(n), 1))

# Meand and SDs for compersion subscales
aux2 <- compersion_m |> 
  mutate(rel_type = fct_relevel(fct_infreq(rel_type), "Other", after = Inf)) |> 
  filter(!is.na(rel_type)) |> 
  pivot_longer(c(EM, SA, NC),
               names_to = "subscale", 
               values_to = "value") |>
  mutate(subscale = factor(subscale, levels = c("EM", "SA", "NC"))) |> 
  group_by(subscale, rel_type) |> 
  summarize(M = round(mean(value, na.rm = T), 2),
            SD = round(sd(value, na.rm = T), 2)) |> 
  pivot_wider(names_from = subscale, values_from = c(M, SD), names_vary = "slowest") |> 
  dplyr::select(-rel_type)

# Print summary table
bind_cols(aux1, aux2) |> 
  kbl() |> kable_styling()
rel_type n prop (%) M_EM SD_EM M_SA SD_SA M_NC SD_NC
Polyamorous 247 74.8 3.97 1.14 1.85 1.20 3.18 1.33
Open 30 9.1 3.36 1.27 2.23 1.33 3.11 1.28
Relationship anarchy 30 9.1 3.76 1.15 1.74 1.15 3.41 0.88
Mono/poly 9 2.7 2.94 1.59 1.70 1.23 2.74 1.40
Monogamish 4 1.2 2.60 1.70 2.00 1.73 1.83 1.02
Swinging 4 1.2 3.85 1.01 3.50 0.79 3.67 0.84
Swolly 1 0.3 3.80 NA 1.00 NA 4.67 0.00
Other 5 1.5 3.83 1.32 2.44 1.31 2.87 1.01

Unconditional means models

All analyses considered the following three-level structure: metamours (level 1) within partners (level 2) within participants (level 3).

EM and SA are level 1 variables and NC is a level 2 variable.

m0_EM <- lmer(formula = EM ~ 1 + (1|participant/partner), 
                data = compersion_m,
                na.action = na.exclude)
m0_SA <- lmer(formula = SA ~ 1 + (1|participant/partner), 
                data = compersion_m,
                na.action = na.exclude)
m0_NC <- lmer(formula = NC ~ 1 + (1|participant), 
               data = compersion_p,
               na.action = na.exclude)

performance::icc(m0_EM, by_group = T)
## # ICC by Group
## 
## Group               |   ICC
## ---------------------------
## partner:participant | 0.129
## participant         | 0.123
performance::icc(m0_SA, by_group = T)
## # ICC by Group
## 
## Group               |   ICC
## ---------------------------
## partner:participant | 0.182
## participant         | 0.238
performance::icc(m0_NC, by_group = T)
## # ICC by Group
## 
## Group       |   ICC
## -------------------
## participant | 0.425

The proportion of variance explained by the three-level structure, measured by the intraclass correlation coefficient (ICC), was 0.25 for C-EM, 0.42 for C-SA, and 0.425 for C-NC, which indicates the appropriateness of using multilevel models in this study.

Are the mean values for the compersion variables significantly different?

df <- compersion_m |> 
  pivot_longer(c(EM, SA, NC),
               names_to = "subscale", 
               values_to = "value")
df |> 
  group_by(subscale) |> 
  summarize(M = round(mean(value, na.rm = T), 2),
            Mdn = round(median(value, na.rm = T), 2),
            SD = round(sd(value, na.rm = T), 2),
            skewness = round(skewness(value, na.rm = T), 2)) |> 
  kbl() |> kable_styling()
subscale M Mdn SD skewness
EM 3.85 4.2 1.19 -0.90
NC 3.17 3.0 1.29 -0.16
SA 1.89 1.0 1.22 1.27

Linear multilevel model with random intercepts and subscale type as a fixed effect:

m <- lmer(
  formula = value ~ subscale + (1|participant/partner), 
  data = df,
  na.action = na.exclude
  )
emm <- emmeans(m, "subscale")
pairs(emm, adjust = "none")
##  contrast estimate     SE   df t.ratio p.value
##  EM - NC     0.679 0.0614 1186  11.051  <.0001
##  EM - SA     1.961 0.0670 1172  29.259  <.0001
##  NC - SA     1.282 0.0614 1186  20.880  <.0001
## 
## Degrees-of-freedom method: kenward-roger

The average endorsement for C-EM was significantly higher than C-NC (p < 0.001), which in turn was significantly higher than C-SA (p < 0.001).

Standard deviations of outcome variables for finding standardized slopes

sd_EM <- sd(compersion_m$EM, na.rm = T)
sd_SA <- sd(compersion_m$SA, na.rm = T)
sd_NC <- sd(compersion_m$NC, na.rm = T)

Hypotheses

Store model results in a data frame called hyp_results.

hyp_results <- data.frame(hyp = NA, IV = NA, DV = NA, beta = NA, b = NA, SE = NA, df = NA, t = NA, p = NA)

1) We expect younger (vs older) individuals to report greater compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$age, na.rm = T)

# model EM
m1 <- lmer(EM ~ age + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ age + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ age + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 1
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "age"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

2) We expect non-binary (vs men and women) individuals to report greater compersion.

gender01: 1 = “Non-binary”, 0 = “woman”or Man”

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$gender01, na.rm = T)

# model EM
m1 <- lmer(EM ~ gender01 + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ gender01 + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ gender01 + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 2
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "gender"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

3) We expect LGBQ (vs heterosexual) individuals to report greater compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$orientation, na.rm = T)

# model EM
m1 <- lmer(EM ~ orientation + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ orientation + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ orientation + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 3
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "orientation"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

4) We expect individuals in longer relationships to report greater compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$length, na.rm = T)

# model EM
m1 <- lmer(EM ~ length + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ length + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ length + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 4
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "length"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

5) We expect individuals in local (vs long-distance) relationships to report greater compersion.

distance: 1 = long-distance, 0 = not long-distance

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$distance, na.rm = T)

# model EM
m1 <- lmer(EM ~ distance + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ distance + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ distance + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 5
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "distance"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

6) We expect individuals in polyamorous (versus other forms of CNM) relationships to report greater compersion.

poly: 1 = polyamorous relationship (including relationship anarchy), 0 = other relationship

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$poly, na.rm = T)

# model EM
m1 <- lmer(EM ~ poly + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ poly + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ poly + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 6
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "poly"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

7) We expect individuals in non-hierarchical (vs hierarchical) relationships to report greater compersion.

hierarchy01: 1 = hierarchical, 0: non-hierarchical

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$hierarchy01, na.rm = T)

# model EM
m1 <- lmer(EM ~ hierarchy01 + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ hierarchy01 + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ hierarchy01 + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 7
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "hierarchy"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

8) We expect individuals with at least one other partner to experience greater compersion than those with only one partner.

n_partners01: 1 = more than one partner, 0 = only one partner

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$n_partners01, na.rm = T)

# model EM
m1 <- lmer(EM ~ n_partners01 + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ n_partners01 + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ n_partners01 + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 8
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "n_partners01"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

9) We refrain from offering hypotheses about NRE.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$NRE, na.rm = T)

# model EM
m1 <- lmer(EM ~ NRE + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ NRE + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ NRE + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 9
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "NRE"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

10) We expect knowledge about the partner’s relationship with the metamour to be positively correlated with compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$know, na.rm = T)

# model EM
m1 <- lmer(EM ~ know + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ know + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ know + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 10
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "know"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

11) We expect desire for knowledge about the partner’s relationship with the metamour to be positively correlated with compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$DFK, na.rm = T)

# model EM
m1 <- lmer(EM ~ DFK + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)
 
# model SA
m2 <- lmer(SA ~ DFK + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ DFK + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 11
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "DFK"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

12) We expect satisfaction with knowledge about partner’s relationship with metamour to be positively correlated with compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$SK, na.rm = T)

# model EM
m1 <- lmer(EM ~ SK + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ SK + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ SK + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 12
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "SK"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

13) We expect satisfaction with relationship with one’s metamour to be positively correlated with compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$SRM, na.rm = T)

# model EM
m1 <- lmer(EM ~ SRM + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ SRM + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ SRM + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 13
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "SRM"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

14) We expect envy for one’s partner’s relationship with the metamour to be negatively correlated with compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$envy, na.rm = T)

# model EM
m1 <- lmer(EM ~ envy + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ envy + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ envy + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 14
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "envy"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

19) Securely attached individuals (low in anxiety and avoidance) will experience greater compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$avoidance, na.rm = T)

# model EM
m1 <- lmer(EM ~ avoidance + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ avoidance + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ avoidance + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 19
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp
hyp_results[(hyp*3-2):(hyp*3), 2] <- "avoidance"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])
# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$anxiety, na.rm = T)

# model EM
m1 <- lmer(EM ~ anxiety + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ anxiety + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ anxiety + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 20
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp-1
hyp_results[(hyp*3-2):(hyp*3), 2] <- "anxiety"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

20) We expect individuals who report higher levels of well-being to experience greater compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$well_being, na.rm = T)

# model EM
m1 <- lmer(EM ~ well_being + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ well_being + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ well_being + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 21
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp-1
hyp_results[(hyp*3-2):(hyp*3), 2] <- "well_being"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

21) We expect individuals who report higher levels of openness to experience greater compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$openness, na.rm = T)

# model EM
m1 <- lmer(EM ~ openness + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ openness + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ openness + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 22
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp-1
hyp_results[(hyp*3-2):(hyp*3), 2] <- "openness"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

22) We expect individuals who report higher levels of agreeableness to experience greater compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$agreeableness, na.rm = T)

# model EM
m1 <- lmer(EM ~ agreeableness + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ agreeableness + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ agreeableness + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 23
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp-1
hyp_results[(hyp*3-2):(hyp*3), 2] <- "agreeableness"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

23) We expect individuals who are more satisfied with their communication with their partner to experience more compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$CCS, na.rm = T)

# model EM
m1 <- lmer(EM ~ CCS + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ CCS + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ CCS + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 24
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp-1
hyp_results[(hyp*3-2):(hyp*3), 2] <- "CCS"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

24) Individuals with higher levels of trust in their partner will experience greater compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$trust, na.rm = T)

# model EM
m1 <- lmer(EM ~ trust + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ trust + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ trust + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 25
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp-1
hyp_results[(hyp*3-2):(hyp*3), 2] <- "trust"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

26) Feeling that one’s needs are met within their relationship with their partner is associated with greater compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$RNM, na.rm = T)

# model EM
m1 <- lmer(EM ~ RNM + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ RNM + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ RNM + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 27
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp-1
hyp_results[(hyp*3-2):(hyp*3), 2] <- "RNM"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

27) Those individuals who perceive they have high quality of alternatives will experience higher levels of compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$QA, na.rm = T)

# model EM
m1 <- lmer(EM ~ QA + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ QA + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ QA + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 28
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp-1
hyp_results[(hyp*3-2):(hyp*3), 2] <- "QA"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

28) Those individuals who perceive they have higher levels of social support outside of the relationship will experience higher levels of compersion.

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$SSOP, na.rm = T)

# model EM
m1 <- lmer(EM ~ SSOP + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ SSOP + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ SSOP + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 29
hyp_results[(hyp*3-2):(hyp*3), 1] <- hyp-1
hyp_results[(hyp*3-2):(hyp*3), 2] <- "SSOP"

hyp_results[(hyp*3-2), 3] <- "EM"
hyp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
hyp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
hyp_results[(hyp*3-1), 3] <- "SA"
hyp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
hyp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
hyp_results[(hyp*3), 3] <- "NC"
hyp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
hyp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

Adjust p-values and print results:

hyp_results$p_adj <- p.adjust(hyp_results$p, method = "fdr")

Round results:

f <- function(x){round(x, digits = 2)} 
f2 <- function(x){round(x, digits = 4)} 
hyp_results_round <- hyp_results
hyp_results_round$beta <- f(hyp_results$beta)
hyp_results_round$b <- f(hyp_results$b)
hyp_results_round$SE <- f(hyp_results$SE)
hyp_results_round$df <- f(hyp_results$df)
hyp_results_round$t <- f(hyp_results$t)
hyp_results_round$p <- f2(hyp_results$p)
hyp_results_round$p_adj <- f2(hyp_results$p_adj)

Print results:

library(kableExtra)
kable_styling(kbl(hyp_results_round))
hyp IV DV beta b SE df t p p_adj
1 age EM 0.03 0.00 0.01 248.22 0.60 0.5496 0.6461
1 age SA 0.00 0.00 0.01 227.08 -0.09 0.9313 0.9532
1 age NC 0.00 0.00 0.01 262.84 0.00 0.9963 0.9963
2 gender EM -0.10 -0.33 0.17 247.35 -1.94 0.0534 0.1033
2 gender SA -0.10 -0.32 0.18 232.16 -1.78 0.0768 0.1422
2 gender NC 0.02 0.08 0.21 265.46 0.39 0.6992 0.7700
3 orientation EM 0.04 0.10 0.14 251.66 0.70 0.4827 0.6087
3 orientation SA 0.04 0.10 0.15 225.73 0.63 0.5282 0.6305
3 orientation NC 0.08 0.24 0.17 258.13 1.38 0.1689 0.2623
4 length EM 0.05 0.01 0.01 312.52 1.01 0.3141 0.4480
4 length SA 0.04 0.01 0.01 311.42 0.82 0.4156 0.5479
4 length NC 0.08 0.01 0.01 266.23 1.48 0.1414 0.2321
5 distance EM -0.11 -0.29 0.13 301.26 -2.18 0.0297 0.0626
5 distance SA -0.08 -0.21 0.14 305.55 -1.56 0.1196 0.2041
5 distance NC -0.06 -0.18 0.15 292.44 -1.18 0.2381 0.3452
6 poly EM 0.20 0.64 0.17 329.15 3.84 0.0001 0.0005
6 poly SA -0.08 -0.28 0.18 312.08 -1.59 0.1130 0.1966
6 poly NC 0.07 0.26 0.19 321.09 1.32 0.1863 0.2795
7 hierarchy EM 0.05 0.13 0.13 294.67 0.98 0.3286 0.4538
7 hierarchy SA 0.17 0.43 0.14 298.41 3.12 0.0020 0.0056
7 hierarchy NC -0.04 -0.12 0.15 313.00 -0.77 0.4438 0.5725
8 n_partners01 EM 0.18 0.50 0.16 316.10 3.12 0.0020 0.0056
8 n_partners01 SA 0.09 0.25 0.17 290.03 1.45 0.1481 0.2354
8 n_partners01 NC 0.18 0.55 0.19 292.10 2.96 0.0034 0.0088
9 NRE EM -0.07 -0.20 0.14 418.19 -1.45 0.1488 0.2354
9 NRE SA 0.12 0.35 0.14 409.93 2.50 0.0129 0.0296
9 NRE NC 0.07 0.23 0.18 318.65 1.29 0.1992 0.2938
10 know EM 0.32 0.15 0.02 418.92 6.76 0.0000 0.0000
10 know SA 0.32 0.16 0.02 421.32 6.90 0.0000 0.0000
10 know NC 0.28 0.15 0.03 308.76 5.14 0.0000 0.0000
11 DFK EM 0.42 0.21 0.02 412.87 8.99 0.0000 0.0000
11 DFK SA 0.42 0.21 0.02 414.73 9.32 0.0000 0.0000
11 DFK NC 0.31 0.17 0.03 319.88 5.76 0.0000 0.0000
12 SK EM 0.37 0.21 0.03 411.93 7.99 0.0000 0.0000
12 SK SA 0.10 0.06 0.03 421.55 2.13 0.0336 0.0665
12 SK NC 0.27 0.17 0.03 309.89 5.09 0.0000 0.0000
13 SRM EM 0.24 0.11 0.02 401.37 5.18 0.0000 0.0000
13 SRM SA 0.08 0.04 0.02 409.17 1.65 0.0993 0.1762
13 SRM NC 0.12 0.06 0.03 321.32 2.14 0.0330 0.0665
14 envy EM -0.24 -0.13 0.03 407.70 -4.91 0.0000 0.0000
14 envy SA 0.01 0.00 0.03 421.93 0.11 0.9101 0.9532
14 envy NC -0.31 -0.18 0.03 321.05 -5.79 0.0000 0.0000
15 close EM 0.56 0.22 0.02 386.53 13.52 0.0000 0.0000
15 close SA 0.42 0.17 0.02 379.85 9.77 0.0000 0.0000
15 close NC 0.22 0.09 0.02 322.83 3.81 0.0002 0.0006
16 ER EM 0.16 0.35 0.11 241.10 3.09 0.0023 0.0061
16 ER SA 0.03 0.08 0.12 213.07 0.63 0.5290 0.6305
16 ER NC 0.03 0.07 0.14 248.14 0.51 0.6137 0.7025
17 RJ EM -0.33 -0.17 0.03 380.90 -6.44 0.0000 0.0000
17 RJ SA -0.07 -0.04 0.03 356.69 -1.33 0.1846 0.2795
17 RJ NC -0.36 -0.20 0.03 318.50 -7.22 0.0000 0.0000
17 AJ EM -0.32 -0.13 0.02 341.36 -6.61 0.0000 0.0000
17 AJ SA -0.03 -0.01 0.02 336.73 -0.48 0.6329 0.7151
17 AJ NC -0.37 -0.16 0.02 319.93 -7.26 0.0000 0.0000
19 avoidance EM -0.19 -0.23 0.06 303.45 -3.79 0.0002 0.0006
19 avoidance SA -0.03 -0.04 0.06 309.42 -0.66 0.5096 0.6244
19 avoidance NC -0.23 -0.30 0.07 279.19 -4.44 0.0000 0.0001
19 anxiety EM -0.20 -0.16 0.04 307.61 -3.97 0.0001 0.0003
19 anxiety SA 0.00 0.00 0.04 315.44 0.02 0.9819 0.9933
19 anxiety NC -0.32 -0.28 0.04 295.59 -6.43 0.0000 0.0000
20 well_being EM 0.23 0.08 0.02 251.09 4.50 0.0000 0.0000
20 well_being SA 0.09 0.04 0.02 221.58 1.71 0.0881 0.1598
20 well_being NC 0.16 0.06 0.02 256.39 2.66 0.0084 0.0202
21 openness EM 0.09 0.23 0.13 243.05 1.80 0.0725 0.1372
21 openness SA -0.01 -0.03 0.14 215.98 -0.21 0.8357 0.9048
21 openness NC 0.05 0.12 0.16 254.90 0.76 0.4475 0.5725
22 agreeableness EM 0.05 0.10 0.12 243.30 0.87 0.3864 0.5172
22 agreeableness SA -0.05 -0.13 0.13 217.11 -0.99 0.3218 0.4516
22 agreeableness NC 0.03 0.07 0.15 261.69 0.46 0.6440 0.7183
23 CCS EM 0.14 0.24 0.09 301.13 2.85 0.0047 0.0117
23 CCS SA 0.00 -0.01 0.09 303.12 -0.09 0.9301 0.9532
23 CCS NC 0.13 0.24 0.10 299.09 2.52 0.0124 0.0291
24 trust EM 0.23 0.29 0.06 336.27 4.48 0.0000 0.0000
24 trust SA -0.01 -0.01 0.07 331.29 -0.10 0.9189 0.9532
24 trust NC 0.25 0.34 0.07 284.31 4.98 0.0000 0.0000
25 self_esteem EM 0.15 0.03 0.01 234.26 2.87 0.0045 0.0116
25 self_esteem SA 0.03 0.01 0.01 211.47 0.59 0.5578 0.6471
25 self_esteem NC 0.01 0.00 0.01 249.74 0.20 0.8424 0.9048
26 RNM EM 0.11 0.04 0.02 302.88 2.18 0.0302 0.0626
26 RNM SA 0.08 0.03 0.02 297.93 1.54 0.1256 0.2102
26 RNM NC 0.16 0.07 0.02 280.61 3.17 0.0017 0.0051
27 QA EM 0.18 0.06 0.02 343.93 3.47 0.0006 0.0018
27 QA SA -0.05 -0.02 0.02 336.59 -0.88 0.3780 0.5139
27 QA NC 0.13 0.05 0.02 321.95 2.35 0.0194 0.0433
28 SSOP EM 0.21 0.28 0.07 296.88 4.14 0.0000 0.0002
28 SSOP SA -0.04 -0.05 0.07 283.55 -0.67 0.5027 0.6244
28 SSOP NC 0.13 0.19 0.08 306.58 2.28 0.0231 0.0503

Export results:

write.csv(hyp_results_round, "hyp_results_round.csv", row.names = FALSE)
write.csv(hyp_results, "hyp_results.csv", row.names = FALSE)

Exploratory analyses

Store model results in a data frame called exp_results.

exp_results <- data.frame(Analysis = NA, IV = NA, DV = NA, beta = NA, b = NA, SE = NA, df = NA, t = NA, p = NA)

3) Does the number of one’s partners’ intimate partners relate to compersion?

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$n_partners2, na.rm = T)

# model EM
m1 <- lmer(EM ~ n_partners2 + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ n_partners2 + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ n_partners2 + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 15
exp_results[(hyp*3-2):(hyp*3), 1] <- hyp
exp_results[(hyp*3-2):(hyp*3), 2] <- "n_partners2"

exp_results[(hyp*3-2), 3] <- "EM"
exp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
exp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
exp_results[(hyp*3-1), 3] <- "SA"
exp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
exp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
exp_results[(hyp*3), 3] <- "NC"
exp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
exp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

4) Is there an interaction between attachment anxiety and avoidance in predicting compersion?

# standardize variables
compersion_m$anxiety_s <- scale(compersion_m$anxiety)[,1]
compersion_m$avoidance_s <- scale(compersion_m$avoidance)[,1]
compersion_p$anxiety_s <- scale(compersion_p$anxiety)[,1]
compersion_p$avoidance_s <- scale(compersion_p$avoidance)[,1]
compersion_m$EM_s <- scale(compersion_m$EM)[,1]
compersion_m$SA_s <- scale(compersion_m$SA)[,1]
compersion_p$NC_s <- scale(compersion_p$NC)[,1]

# model EM
m1 <- lmer(EM_s ~ anxiety_s*avoidance_s + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA_s ~ anxiety_s*avoidance_s + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC_s ~ anxiety_s*avoidance_s + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 16
exp_results[(hyp*3-2):(hyp*3), 1] <- hyp
exp_results[(hyp*3-2):(hyp*3), 2] <- "anxiety*avoidance"

exp_results[(hyp*3-2), 3] <- "EM"
exp_results[(hyp*3-2), 4] <- s1$coefficients[4,1]
exp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[4,])
exp_results[(hyp*3-1), 3] <- "SA"
exp_results[(hyp*3-1), 4] <- s2$coefficients[4,1]
exp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[4,])
exp_results[(hyp*3), 3] <- "NC"
exp_results[(hyp*3), 4] <- s3$coefficients[4,1]
exp_results[(hyp*3), 5:9] <- t(s3$coefficients[4,])

5) Does transgender status relate to compersion?

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$trans, na.rm = T)

# model EM
m1 <- lmer(EM ~ trans + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ trans + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ trans + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 17
exp_results[(hyp*3-2):(hyp*3), 1] <- hyp
exp_results[(hyp*3-2):(hyp*3), 2] <- "transgender"

exp_results[(hyp*3-2), 3] <- "EM"
exp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
exp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
exp_results[(hyp*3-1), 3] <- "SA"
exp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
exp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
exp_results[(hyp*3), 3] <- "NC"
exp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
exp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

6) Does desired closeness with metamour relate to compersion?

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$Pclose, na.rm = T)

# model EM
m1 <- lmer(EM ~ Pclose + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ Pclose + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ Pclose + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 18
exp_results[(hyp*3-2):(hyp*3), 1] <- hyp
exp_results[(hyp*3-2):(hyp*3), 2] <- "Pclose"

exp_results[(hyp*3-2), 3] <- "EM"
exp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
exp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
exp_results[(hyp*3-1), 3] <- "SA"
exp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
exp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
exp_results[(hyp*3), 3] <- "NC"
exp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
exp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

7) Does being intimately involved to metamour relate to compersion?

IIM01: 1 = currently intimately involved with all metamours, 0.5 = currently intimately involved with one of two metamours, 0 = currently not intimately involved with any metamour

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$IIM01, na.rm = T)

# model EM
m1 <- lmer(EM ~ IIM01 + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ IIM01 + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ IIM01 + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 19
exp_results[(hyp*3-2):(hyp*3), 1] <- hyp
exp_results[(hyp*3-2):(hyp*3), 2] <- "IIM"

exp_results[(hyp*3-2), 3] <- "EM"
exp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
exp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
exp_results[(hyp*3-1), 3] <- "SA"
exp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
exp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
exp_results[(hyp*3), 3] <- "NC"
exp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
exp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

8) Does predating metamour relate to compersion?

predate: 1 = predates all metamours, 0.5 = predates one of two metamours, 0 = predates none of the metamours

# std. dev. of IV for finding standardized slope
sd_IV <- sd(compersion_m$predate, na.rm = T)

# model EM
m1 <- lmer(EM ~ predate + (1 | participant/partner), data = compersion_m)
s1 <- summary(m1)

# model SA
m2 <- lmer(SA ~ predate + (1 | participant/partner), data = compersion_m)
s2 <- summary(m2)

# model NC
m3 <- lmer(NC ~ predate + (1 | participant), data = compersion_p)
s3 <- summary(m3)

hyp <- 20
exp_results[(hyp*3-2):(hyp*3), 1] <- hyp
exp_results[(hyp*3-2):(hyp*3), 2] <- "predate"

exp_results[(hyp*3-2), 3] <- "EM"
exp_results[(hyp*3-2), 4] <- s1$coefficients[2,1]*sd_IV/sd_EM
exp_results[(hyp*3-2), 5:9] <- t(s1$coefficients[2,])
exp_results[(hyp*3-1), 3] <- "SA"
exp_results[(hyp*3-1), 4] <- s2$coefficients[2,1]*sd_IV/sd_SA
exp_results[(hyp*3-1), 5:9] <- t(s2$coefficients[2,])
exp_results[(hyp*3), 3] <- "NC"
exp_results[(hyp*3), 4] <- s3$coefficients[2,1]*sd_IV/sd_NC
exp_results[(hyp*3), 5:9] <- t(s3$coefficients[2,])

p-value adjustment:

exp_results$p_adj <- p.adjust(exp_results$p, method = "fdr")

Round results:

exp_results_round <- exp_results
exp_results_round$beta <- f(exp_results$beta)
exp_results_round$b <- f(exp_results$b)
exp_results_round$SE <- f(exp_results$SE)
exp_results_round$df <- f(exp_results$df)
exp_results_round$t <- f(exp_results$t)
exp_results_round$p <- f2(exp_results$p)
exp_results_round$p_adj <- f2(exp_results$p_adj)

Print results:

kable_styling(kbl(exp_results_round))
Analysis IV DV beta b SE df t p p_adj
1 ATF EM 0.06 0.11 0.09 241.56 1.21 0.2271 0.4418
1 ATF SA 0.01 0.02 0.10 216.79 0.20 0.8389 0.9274
1 ATF NC 0.00 0.00 0.11 256.17 0.01 0.9918 0.9918
2 BPF EM 0.11 0.15 0.07 226.40 2.07 0.0399 0.1027
2 BPF SA 0.06 0.08 0.08 202.80 1.05 0.2938 0.5037
2 BPF NC 0.02 0.02 0.09 242.92 0.25 0.7996 0.9274
3 CF EM 0.08 0.13 0.09 229.56 1.53 0.1286 0.2675
3 CF SA 0.00 -0.01 0.09 207.43 -0.08 0.9331 0.9737
3 CF NC -0.06 -0.11 0.11 246.86 -1.00 0.3173 0.5313
4 UF EM 0.13 0.21 0.09 224.73 2.49 0.0134 0.0461
4 UF SA 0.03 0.06 0.09 200.48 0.60 0.5470 0.7574
4 UF NC 0.05 0.10 0.11 246.84 0.91 0.3645 0.5813
5 AF EM 0.13 0.22 0.09 238.87 2.57 0.0109 0.0391
5 AF SA 0.08 0.15 0.09 207.88 1.55 0.1221 0.2663
5 AF NC 0.06 0.11 0.11 248.05 1.05 0.2936 0.5037
6 RTEF EM 0.14 0.22 0.08 244.71 2.67 0.0082 0.0332
6 RTEF SA 0.06 0.10 0.09 218.49 1.17 0.2453 0.4647
6 RTEF NC 0.04 0.08 0.10 256.08 0.74 0.4595 0.7039
7 RCUE EM 0.14 0.21 0.08 237.87 2.61 0.0097 0.0368
7 RCUE SA 0.01 0.01 0.09 214.26 0.10 0.9175 0.9714
7 RCUE NC -0.04 -0.06 0.10 250.52 -0.61 0.5417 0.7574
8 SS EM 0.14 0.23 0.09 242.95 2.66 0.0083 0.0332
8 SS SA 0.00 0.00 0.09 221.06 0.04 0.9646 0.9918
8 SS NC -0.01 -0.02 0.11 258.75 -0.23 0.8149 0.9274
9 M EM 0.14 0.20 0.08 228.23 2.66 0.0083 0.0332
9 M SA -0.01 -0.02 0.08 203.37 -0.19 0.8501 0.9274
9 M NC 0.13 0.21 0.10 246.57 2.21 0.0283 0.0843
10 SCP EM 0.04 0.06 0.08 324.47 0.72 0.4701 0.7051
10 SCP SA -0.07 -0.12 0.09 315.18 -1.39 0.1640 0.3280
10 SCP NC 0.01 0.02 0.10 305.49 0.23 0.8175 0.9274
11 SEE EM 0.15 0.22 0.07 314.28 3.07 0.0023 0.0127
11 SEE SA 0.00 0.00 0.08 318.02 -0.02 0.9876 0.9918
11 SEE NC 0.13 0.20 0.08 311.58 2.43 0.0157 0.0514
12 PR EM 0.16 0.19 0.06 286.03 3.17 0.0017 0.0110
12 PR SA -0.01 -0.02 0.06 283.53 -0.28 0.7768 0.9274
12 PR NC 0.10 0.12 0.07 283.76 1.83 0.0682 0.1637
13 PC EM 0.10 0.11 0.06 308.84 1.94 0.0529 0.1313
13 PC SA 0.01 0.02 0.06 310.17 0.28 0.7808 0.9274
13 PC NC 0.12 0.15 0.07 291.60 2.34 0.0201 0.0628
14 CC EM 0.11 0.15 0.07 299.80 2.19 0.0293 0.0843
14 CC SA 0.03 0.05 0.07 303.03 0.63 0.5283 0.7574
14 CC NC 0.15 0.23 0.08 297.05 2.97 0.0032 0.0165
15 n_partners2 EM -0.08 -0.08 0.04 231.99 -1.75 0.0812 0.1886
15 n_partners2 SA -0.05 -0.05 0.05 249.66 -1.11 0.2683 0.4954
15 n_partners2 NC -0.01 -0.02 0.05 310.48 -0.28 0.7816 0.9274
16 anxiety*avoidance EM -0.06 -0.06 0.04 309.95 -1.56 0.1201 0.2663
16 anxiety*avoidance SA -0.04 -0.04 0.04 318.17 -0.90 0.3672 0.5813
16 anxiety*avoidance NC -0.06 -0.06 0.04 263.64 -1.52 0.1301 0.2675
17 transgender EM 0.02 0.08 0.18 221.21 0.44 0.6638 0.8535
17 transgender SA 0.01 0.02 0.19 203.41 0.11 0.9127 0.9714
17 transgender NC 0.13 0.48 0.22 253.06 2.17 0.0312 0.0865
18 Pclose EM 0.62 0.26 0.02 396.97 15.63 0.0000 0.0000
18 Pclose SA 0.46 0.19 0.02 382.07 10.67 0.0000 0.0000
18 Pclose NC 0.19 0.09 0.03 319.85 3.32 0.0010 0.0078
19 IIM EM 0.21 0.72 0.16 389.44 4.48 0.0000 0.0002
19 IIM SA 0.45 1.56 0.15 370.30 10.35 0.0000 0.0000
19 IIM NC -0.03 -0.10 0.22 310.84 -0.44 0.6604 0.8535
20 predate EM -0.03 -0.07 0.12 388.81 -0.56 0.5754 0.7816
20 predate SA 0.04 0.11 0.12 391.89 0.89 0.3714 0.5813
20 predate NC 0.23 0.59 0.14 277.06 4.34 0.0000 0.0003
21 TS EM 0.16 0.16 0.05 308.07 3.12 0.0020 0.0118
21 TS SA -0.03 -0.03 0.05 306.73 -0.62 0.5363 0.7574
21 TS NC 0.02 0.03 0.06 321.12 0.45 0.6539 0.8535
22 EIS EM 0.19 0.24 0.06 290.29 3.83 0.0002 0.0014
22 EIS SA -0.06 -0.07 0.07 274.89 -1.08 0.2811 0.5037
22 EIS NC 0.18 0.25 0.08 300.62 3.30 0.0011 0.0078
23 AS EM 0.19 0.22 0.06 306.59 3.82 0.0002 0.0014
23 AS SA -0.01 -0.01 0.06 296.14 -0.22 0.8267 0.9274
23 AS NC 0.12 0.14 0.07 314.58 2.10 0.0362 0.0964
24 PSIS EM 0.21 0.28 0.07 299.56 4.14 0.0000 0.0005
24 PSIS SA -0.02 -0.02 0.07 284.32 -0.29 0.7722 0.9274
24 PSIS NC 0.16 0.24 0.08 303.29 2.90 0.0040 0.0192

Export results:

write.csv(exp_results, "exp_results.csv", row.names = F)
write.csv(exp_results_round, "exp_results_round.csv", row.names = F)

8) Which factors are the strongest predictors of compersion?

aux1 <- exp_results
names(aux1)[1] <- "hyp"
aux <- rbind(hyp_results, aux1[aux1$IV %in% c("Pclose", "IIM", "predate"),])
EM_results <- subset(aux, aux$DV == "EM")
SA_results <- subset(aux, aux$DV == "SA")
NC_results <- subset(aux, aux$DV == "NC")

EM:

EM_results_ordered <- EM_results[order(EM_results$beta),]
EM_results_ordered$sig <- 1*(EM_results_ordered$p_adj < 0.05)
row.names(EM_results_ordered) <- EM_results_ordered$IV
f <- function(x){if(x==1) {"cadetblue"} else {"coral"}}
EM_results_ordered$col <- unlist(lapply(EM_results_ordered$sig, f))
par(mar=c(5,8.5,1,1)+.1) # c('bottom', 'left', 'top', 'right')
barplot(EM_results_ordered$beta, names.arg = rownames(EM_results_ordered), main = "EM", horiz = T, col = EM_results_ordered$col, xlab = "Beta", cex.names = 0.75, las=2, xpd=T, xlim = c(-0.5, 0.6))
grid(11, NA, col = "lightgray", lty = "dotted",
     lwd = par("lwd"))
legend("bottomright", c("significant", "non-sig."), fill = c("cadetblue", "coral"), bty = "n", cex = 0.75)

Excluding non-significant results:

EM_results_ordered <- EM_results[order(abs(EM_results$beta)),]
EM_results_ordered$sig <- 1*(EM_results_ordered$p_adj < 0.05)
EM_results_ordered$positive <- 1*(EM_results_ordered$beta > 0)
EM_results_ordered$beta2 <- abs(EM_results_ordered$beta)
row.names(EM_results_ordered) <- EM_results_ordered$IV
f <- function(x){if(x==1) {"cadetblue"} else {"coral"}}
EM_results_ordered$col <- unlist(lapply(EM_results_ordered$positive, f))
EM_results_ordered2 <- EM_results_ordered[EM_results_ordered$p_adj < 0.05,]
par(mar=c(5,8.5,1,1)+.1) # c('bottom', 'left', 'top', 'right')
barplot(EM_results_ordered2$beta2, 
        #names.arg = rownames(EM_results_ordered2),
        names.arg = c("Communication", "Self-esteem", "Emotion regulation", "More than one partner",  "Quality of alternatives", "Avoidance", "Polyamorous", "Anxiety", "Social support", "Intimate with metamour", "Trust", "Well-being", "Envy", "Satisfaction w/ metamour", "Knowledge", "Anxious jealousy", "Reactive jealousy", "Satisfaction w/ knowledge", "Desire for knowledge", "Closeness w/ metamour",  "Desired closeness"), 
        main = "C-EM", horiz = T, col = EM_results_ordered2$col, xlab = "Standardized slope", cex.names = 0.75, las=2, xpd=T, xlim = c(0, 0.65))
abline(v = c(0.1, 0.3, 0.5), lty = "dashed")
#grid(11, NA, col = "lightgray", lty = "dotted",
#     lwd = par("lwd"))
legend("bottomright", c("positive", "negative"), fill = c("cadetblue", "coral"), bty = "n", cex = 0.75)

SA:

SA_results_ordered <- SA_results[order(SA_results$beta),]
SA_results_ordered$sig <- 1*(SA_results_ordered$p_adj < 0.05)
row.names(SA_results_ordered) <- SA_results_ordered$IV
f <- function(x){if(x==1) {"cadetblue"} else {"coral"}}
SA_results_ordered$col <- unlist(lapply(SA_results_ordered$sig, f))
par(mar=c(5,8.5,1,1)+.1) # c('bottom', 'left', 'top', 'right')
barplot(SA_results_ordered$beta, main = "SA", names.arg = rownames(SA_results_ordered), horiz = T, col = SA_results_ordered$col, xlab = "Beta", cex.names = 0.75, las=2, xpd=T, xlim = c(-0.5, 0.6))
grid(11, NA, col = "lightgray", lty = "dotted",
     lwd = par("lwd"))
legend("bottomright", c("significant", "non-sig."), fill = c("cadetblue", "coral"), bty = "n", cex = 0.75)

Excluding non-significant results:

SA_results_ordered <- SA_results[order(abs(SA_results$beta)),]
SA_results_ordered$sig <- 1*(SA_results_ordered$p_adj < 0.05)
SA_results_ordered$positive <- 1*(SA_results_ordered$beta > 0)
SA_results_ordered$beta2 <- abs(SA_results_ordered$beta)
row.names(SA_results_ordered) <- SA_results_ordered$IV
f <- function(x){if(x==1) {"cadetblue"} else {"coral"}}
SA_results_ordered$col <- unlist(lapply(SA_results_ordered$positive, f))
SA_results_ordered2 <- SA_results_ordered[SA_results_ordered$p_adj < 0.05,]
par(mar=c(5,8.5,1,1)+.1) # c('bottom', 'left', 'top', 'right')
barplot(SA_results_ordered2$beta2, 
        #names.arg = rownames(SA_results_ordered2),
        names.arg = c("New relationship energy", "Hierarchy", "Knowledge", "Desire for knowledge", "Closeness w/ metamour", "Intimate with metamour", "Desired closeness"),
        main = "C-SA", horiz = T, col = SA_results_ordered2$col, xlab = "Standardized slope", cex.names = 0.75, las=2, xpd=T, xlim = c(0, 0.51))
abline(v = c(0.1, 0.3, 0.5), lty = "dashed")
#grid(11, NA, col = "lightgray", lty = "dotted",
#     lwd = par("lwd"))
legend("bottomright", c("positive", "negative"), fill = c("cadetblue", "coral"), bty = "n", cex = 0.75)

NC:

NC_results_ordered <- NC_results[order(NC_results$beta),]
NC_results_ordered$sig <- 1*(NC_results_ordered$p_adj < 0.05)
row.names(NC_results_ordered) <- NC_results_ordered$IV
f <- function(x){if(x==1) {"cadetblue"} else {"coral"}}
NC_results_ordered$col <- unlist(lapply(NC_results_ordered$sig, f))
par(mar=c(5,8.5,1,1)+.1) # c('bottom', 'left', 'top', 'right')
barplot(NC_results_ordered$beta, main = "NC", names.arg = rownames(NC_results_ordered), horiz = T, col = NC_results_ordered$col, xlab = "Beta", cex.names = 0.75, las=2, xpd=T, xlim = c(-0.5, 0.6))
grid(11, NA, col = "lightgray", lty = "dotted",
     lwd = par("lwd"))
legend("bottomright", c("significant", "non-sig."), fill = c("cadetblue", "coral"), bty = "n", cex = 0.75)

Excluding non-significant results:

NC_results_ordered <- NC_results[order(abs(NC_results$beta)),]
NC_results_ordered$sig <- 1*(NC_results_ordered$p_adj < 0.05)
NC_results_ordered$positive <- 1*(NC_results_ordered$beta > 0)
NC_results_ordered$beta2 <- abs(NC_results_ordered$beta)
row.names(NC_results_ordered) <- NC_results_ordered$IV
f <- function(x){if(x==1) {"cadetblue"} else {"coral"}}
NC_results_ordered$col <- unlist(lapply(NC_results_ordered$positive, f))
NC_results_ordered2 <- NC_results_ordered[NC_results_ordered$p_adj < 0.05,]
par(mar=c(5,8.5,1,1)+.1) # c('bottom', 'left', 'top', 'right')
barplot(NC_results_ordered2$beta2, 
        #names.arg = rownames(NC_results_ordered2),
        names.arg = c("Quality of alternatives", "Communication",    "Well-being", "Relationship needs met",  "More than one partner", "Desired closeness", "Closeness w/ metamour", "Avoidance", "Predate metamour", "Trust", "Satisfaction w/ knowledge", "Knowledge", "Envy", "Desire for knowledge", "Anxiety", "Reactive jealousy", "Anxious jealousy"),
        main = "C-NC", horiz = T, col = NC_results_ordered2$col, xlab = "Standardized slope", cex.names = 0.75, las=2, xpd=T, xlim = c(0, 0.51))
abline(v = c(0.1, 0.3, 0.5), lty = "dashed")
#grid(11, NA, col = "lightgray", lty = "dotted",
#     lwd = par("lwd"))
legend("bottomright", c("positive", "negative"), fill = c("cadetblue", "coral"), bty = "n", cex = 0.75)

Summaries of predictors

Participant-level:

compersion |> 
  dplyr::select(ATF, BPF, CF, UF, M, AF, RTEF, RCUE, SS, M, ER, well_being, self_esteem, openness, agreeableness, n_partners) |> 
  skim() |> 
  mutate(Variable = skim_variable, Missing = n_missing, Mean = numeric.mean, SD = numeric.sd, Min = numeric.p0, Median = numeric.p50, Max = numeric.p100, ) |> 
  dplyr::select(Variable, Missing, Mean, Median, SD, Min, Max) |> 
  kbl(digits = 2) |> kable_styling()
Variable Missing Mean Median SD Min Max
ATF 1 3.10 3.00 0.67 1.33 4.00
BPF 2 2.80 3.00 0.84 0.33 4.00
CF 1 3.08 3.00 0.71 0.33 4.00
UF 1 3.10 3.00 0.71 0.67 4.00
M 1 2.67 2.67 0.80 0.67 4.00
AF 2 2.92 3.00 0.71 1.00 4.00
RTEF 1 3.07 3.00 0.77 0.33 4.00
RCUE 1 2.88 3.00 0.77 0.33 4.00
SS 1 2.95 3.00 0.73 0.33 4.00
ER 3 2.95 2.96 0.55 1.41 4.00
well_being 0 23.34 23.21 3.29 14.75 32.55
self_esteem 2 31.07 31.00 5.36 15.00 40.00
openness 0 3.81 3.78 0.50 2.22 5.00
agreeableness 0 4.07 4.11 0.53 2.44 5.00
n_partners 2 2.24 2.00 1.16 1.00 10.00

Partner-level:

aux <- compersion_p |> 
  mutate(poly = factor(poly), hierarchy01 = factor(hierarchy01), distance = factor(distance), predate = factor(predate), NRE = factor(NRE), IIM01 = factor(IIM01)) |> 
  dplyr::select(RNM, QA, SCP, SEE, PR, PC, CC, CCS, SCP, TS, EIS, AS, PSIS, SSOP, TS, trust, RJ, AJ, avoidance, anxiety, n_partners2, poly, distance, hierarchy, predate, NRE, IIM01) |> 
  skim()
aux |> 
  filter(skim_type == "factor") |> 
  mutate(Variable = skim_variable, Counts = factor.top_counts) |>
  dplyr::select(Variable, Counts) |> 
  kbl(digits = 2) |> kable_styling()
Variable Counts
poly 1: 277, 0: 53
distance 0: 233, 1: 97
predate 1: 163, 0: 143, 0.5: 24
NRE 0: 241, 1: 62, 0.5: 26
IIM01 0: 262, 1: 37, 0.5: 18 
aux |> 
  filter(skim_type == "numeric") |> 
  mutate(Variable = skim_variable, Mean = numeric.mean, SD = numeric.sd, Min = numeric.p0, Median = numeric.p50, Max = numeric.p100, ) |> 
  dplyr::select(Variable, Mean, Median, SD, Min, Max) |> 
  kbl(digits = 2) |> kable_styling()
Variable Mean Median SD Min Max
RNM 11.26 12.00 3.19 0.00 15
QA 11.49 12.00 3.57 0.00 15
SCP 4.22 4.50 0.72 1.50 5
SEE 3.99 4.00 0.83 1.00 5
PR 4.00 4.00 1.00 1.00 5
PC 3.74 4.00 1.03 1.00 5
CC 4.02 4.00 0.87 1.00 5
CCS 4.00 4.09 0.70 1.36 5
TS 3.71 4.00 1.18 1.00 5
EIS 4.17 4.33 0.93 1.00 5
AS 3.94 4.00 1.03 1.00 5
PSIS 4.04 4.00 0.88 1.00 5
SSOP 3.97 4.08 0.89 1.17 5
trust 1.97 2.29 0.94 -3.00 3
RJ 0.95 0.00 2.32 0.00 20
AJ 2.13 1.00 2.89 0.00 20
avoidance 2.10 2.00 0.98 1.00 7
anxiety 2.27 1.67 1.51 1.00 7
n_partners2 2.66 2.00 1.26 1.00 9

Metamour-level:

aux <- compersion_m |> 
  mutate(predate = factor(predate), NRE = factor(NRE), IIM01 = factor(IIM01)) |> 
  dplyr::select(know, DFK, SK, SRM, envy, close, Pclose, IIM01, predate, NRE) |> 
  skim()
aux |> 
  filter(skim_type == "factor") |> 
  mutate(Variable = skim_variable, Counts = factor.top_counts) |>
  dplyr::select(Variable, Counts) |> 
  kbl(digits = 2) |> kable_styling()
Variable Counts
IIM01 0: 347, 1: 60
predate 1: 229, 0: 196
NRE 0: 329, 1: 96 
aux |> 
  filter(skim_type == "numeric") |> 
  mutate(Variable = skim_variable, Mean = numeric.mean, SD = numeric.sd, Min = numeric.p0, Median = numeric.p50, Max = numeric.p100, ) |> 
  dplyr::select(Variable, Mean, Median, SD, Min, Max) |> 
  kbl(digits = 2) |> kable_styling()
Variable Mean Median SD Min Max
know 6.05 6 2.43 1 10
DFK 6.46 7 2.41 1 10
SK 8.30 9 2.08 1 10
SRM 7.52 8 2.67 1 10
envy 2.52 1 2.21 1 10
close 4.62 4 3.07 1 10
Pclose 5.91 6 2.87 1 10