Love Languages - Theory validation analysis (Studies 1, 2, and 3)

Libraries used

library(kableExtra) # for tables
library(psych) # for alpha()
library(MVN) # for mvn()
library(bcaboot) # for bcajack()
library(car) # for vif()

Data

love1 <- read.csv("love1.csv") # Study 1 data
love2 <- read.csv("love2_sub.csv") # Study 2 data (subsample)
love3 <- read.csv("love3.csv") # Study 3 data

# Cronbach's alphas
alphas1 <- read.csv("alphas1.csv")
alphas2 <- read.csv("alphas2_sub.csv")
alphas3 <- read.csv("alphas3.csv")

Column indexes for:

• love language scores (LL),
• satisfaction with love languages (SLL),
• satisfaction with ranked love languages (RSLL),
• relationship satisfaction (sat), and
• how loved the participant feels (study 3 only).

Study 1:

w1_LL <- which(names(love1) %in% c("words", "touch", "service", "gifts", "quality"))
w1_SLL <- which(names(love1) %in% c("words_sat", "touch_sat", "service_sat", "gifts_sat", "quality_sat"))
w1_RSLL <- which(names(love1) %in% c("R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat"))
w1_sat <- which(names(love1) == "sat")

Study 2:

w2_LL <- which(names(love2) %in% c("words", "touch", "service", "gifts", "quality"))
w2_SLL <- which(names(love2) %in% c("words_sat", "touch_sat", "service_sat", "gifts_sat", "quality_sat"))
w2_RSLL <- which(names(love2) %in% c("R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat"))
w2_sat <- which(names(love2) == "sat")

Study 3:

w3_LL <- which(names(love3) %in% c("words", "touch", "service", "gifts", "quality"))
w3_SLL <- which(names(love3) %in% c("words_sat", "touch_sat", "service_sat", "gifts_sat", "quality_sat"))
w3_RSLL <- which(names(love3) %in% c("R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat"))
w3_sat <- which(names(love3) == "sat")
w3_loved <- which(names(love3) == "loved")

data1 <- love1[,c(w1_LL, w1_SLL, w1_RSLL, w1_sat)]
data2 <- love2[,c(w2_LL, w2_SLL, w2_RSLL, w2_sat)]
data3 <- love3[,c(w3_LL, w3_SLL, w3_RSLL, w3_sat, w3_loved)]

First 10 rows of the data for Study 3:

table <- kable_styling(kbl(head(data3), format = "html", booktabs = TRUE))
scroll_box(table, width = "100%", height = "100%")

words	touch	service	gifts	quality	words_sat	touch_sat	service_sat	gifts_sat	quality_sat	R1_sat	R2_sat	R3_sat	R4_sat	R5_sat	sat	loved
5.00	5.00	5.00	5.00	5.00	5.0	5.00	5.00	5.00	5.00	5.000000	5.000000	5.000000	5.00	5.00	20	9
4.50	5.00	3.75	3.50	3.25	1.0	1.00	1.00	1.00	1.00	1.000000	1.000000	1.000000	1.00	1.00	0	NA
4.75	3.75	4.75	4.00	4.75	4.0	3.50	4.25	3.00	4.25	4.166667	4.166667	4.166667	3.00	3.50	17	7
5.00	3.50	5.00	4.00	5.00	4.0	1.75	4.25	2.75	5.00	4.416667	4.416667	4.416667	2.75	1.75	18	9
3.00	3.00	3.00	3.00	3.00	3.5	3.25	3.25	3.00	3.25	3.250000	3.250000	3.250000	3.25	3.25	9	5
4.50	3.50	3.00	2.75	5.00	3.0	3.50	3.25	3.00	3.00	3.000000	3.000000	3.500000	3.25	3.00	15	7

Skewness and kurtosis

descr1 <- mvn(data1)$Descriptives # Study 1
descr2 <- mvn(data2)$Descriptives # Study 2
descr3 <- mvn(data3)$Descriptives # Study 3

Study 1:

summary(descr1$Skew)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.4324 -1.3057 -1.1692 -1.1162 -0.9274 -0.5712

summary(descr1$Kurtosis)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.2795  0.4664  1.0321  1.0280  1.4233  2.0888

Study 2:

summary(descr2$Skew)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -2.2191 -1.3021 -1.1310 -1.1755 -0.9728 -0.6221

summary(descr2$Kurtosis)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.2234  0.4171  0.6925  1.2492  1.5319  6.2832

Study 3:

summary(descr3$Skew)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.6306 -1.2409 -1.0737 -1.1029 -0.9314 -0.6944

summary(descr3$Kurtosis)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -0.42072 -0.07495  0.42364  0.56879  0.73135  2.41633

Bootstrap functions

cor_type <- "pearson" 

Function that calculates correlation

rfun <- function(data) {# data should have two columns
  return(cor(data[,1], data[,2], method = cor_type, use = "complete.obs"))
}

BCa bootstrap CI for a correlation

bcaCI <- function(data){# data should have two columns
  set.seed(456)
  b <- bcajack(x = data, B = 10000, func = rfun, verbose = FALSE)$lims
  return(c(b[1,1], b[length(b[,1]),1]))
}

Function that calculates the difference between two overlapping correlations

rdiff <- function(data) {# data should have 3 columns, the first is the common variable
  return(rfun(data[,c(1,2)]) - rfun(data[,c(1,3)]))
}

BCa bootstrap CI for the difference between two overlapping correlations

bcaCI_diff <- function(data){# data should have 3 columns, the first is the common variable
  set.seed(789)
  b <- bcajack(x = data, B = 10000, func = rdiff, verbose = FALSE)$lims
  return(c(b[1,1], b[length(b[,1]),1]))
}

Function that calculates the difference between two overlapping correlations, where one correlation is from a subset (gap>0) of the data used to calculate the other correlation.

rdiff2 <- function(data) {# data should have 4 columns, the first is the common variable, the last is "gap"
  return(rfun(data[,c(1,2)]) - rfun(data[data[,4]>0, c(1,3)]))
}

BCa bootstrap CI for the difference between two overlapping correlations, where one correlation is from a subset (gap>0) of the data used to calculate the other correlation.

bcaCI_diff2 <- function(data){# data should have 4 columns, the first is the common variable, the last is "gap"
  set.seed(789)
  b <- bcajack(x = data, B = 10000, func = rdiff2, verbose = FALSE)$lims
  return(c(b[1,1], b[length(b[,1]),1]))
}

Function that finds the standardized slope of a LS line

lm.beta <- function(m) {
  b <- summary(m)$coef[-1, 1]
  sx <- apply(m$model[-1], 2, sd, na.rm = T)
  sy <- apply(m$model[1], 2, sd, na.rm = T)
  beta <- b * sx/sy
  return(beta)
}

Functions that calculate the difference between two standardized regression coefficients within the same model

bdiff2 <- function(data) {# data should have 6 columns, the first is rel. sat., the others are R1_sat, ... R5_sat
  m <- lm(sat ~ R1_sat + R2_sat + R3_sat + R4_sat + R5_sat, data = data)
  b <- lm.beta(m)
  return(b[1] - b[2])
}

bdiff3 <- function(data) {# data should have 6 columns, the first is rel. sat., the others are R1_sat, ... R5_sat
  m <- lm(sat ~ R1_sat + R2_sat + R3_sat + R4_sat + R5_sat, data = data)
  b <- lm.beta(m)
  return(b[1] - b[3])
}

bdiff4 <- function(data) {# data should have 6 columns, the first is rel. sat., the others are R1_sat, ... R5_sat
  m <- lm(sat ~ R1_sat + R2_sat + R3_sat + R4_sat + R5_sat, data = data)
  b <- lm.beta(m)
  return(b[1] - b[4])
}

bdiff5 <- function(data) {# data should have 6 columns, the first is rel. sat., the others are R1_sat, ... R5_sat
  m <- lm(sat ~ R1_sat + R2_sat + R3_sat + R4_sat + R5_sat, data = data)
  b <- lm.beta(m)
  return(b[1] - b[5])
}

BCa bootstrap CI for the difference between two standardized reg coefs within the same model

bcaCI_bdiff2 <- function(data){# data should have 6 columns, the first is rel. sat., the others are R1_sat, ... R5_sat
  set.seed(789)
  b <- bcajack(x = data, B = 10000, func = bdiff2, verbose = FALSE)$lims
  return(c(b[1,1], b[length(b[,1]),1]))
}

bcaCI_bdiff3 <- function(data){# data should have 6 columns, the first is rel. sat., the others are R1_sat, ... R5_sat
  set.seed(789)
  b <- bcajack(x = data, B = 10000, func = bdiff3, verbose = FALSE)$lims
  return(c(b[1,1], b[length(b[,1]),1]))
}

bcaCI_bdiff4 <- function(data){# data should have 6 columns, the first is rel. sat., the others are R1_sat, ... R5_sat
  set.seed(789)
  b <- bcajack(x = data, B = 10000, func = bdiff4, verbose = FALSE)$lims
  return(c(b[1,1], b[length(b[,1]),1]))
}

bcaCI_bdiff5 <- function(data){# data should have 6 columns, the first is rel. sat., the others are R1_sat, ... R5_sat
  set.seed(789)
  b <- bcajack(x = data, B = 10000, func = bdiff5, verbose = FALSE)$lims
  return(c(b[1,1], b[length(b[,1]),1]))
}

Gap distribution

Subsample who have a primary language (that is, the gap between the highest and second highest ranked language is greater than 0):

love1_primary <- love1[love1$gap > 0,]
love2_primary <- love2[love2$gap > 0,]
love3_primary <- love3[love3$gap > 0,]

All gap values in the samples:

t1 <- table(love1$gap)
t2 <- table(love2$gap)
t3 <- table(love3$gap)

nt1 <- as.numeric(names(t1))
nt2 <- as.numeric(names(t2))
nt3 <- as.numeric(names(t3))

How many have gap = 0, 0 < gap < 0.75, and gap >= 75?

a <- 0.75
w1 <- max(which(nt1 < a))
w2 <- max(which(nt2 < a))
w3 <- max(which(nt3 < a))

df <- data.frame(study = c(1,2,3), 
                 n = c(nrow(love1), nrow(love2), nrow(love3)),
                 gap0 = c( # participants with gap = 0
                   paste0(as.numeric(t1[1]), " (", round(100*as.numeric(t1[1]/nrow(love1)), 1), "%)"),
                   paste0(as.numeric(t2[1]), " (", round(100*as.numeric(t2[1]/nrow(love2)), 1), "%)"),
                   paste0(as.numeric(t3[1]), " (", round(100*as.numeric(t3[1]/nrow(love3)), 1), "%)")
                 ),
                 gap1 = c( # participants with 0 < gap < 0.75
                   paste0(sum(t1[2:w1]), " (", round(100*as.numeric(sum(t1[2:w1])/nrow(love1)), 1), "%)"),
                   paste0(sum(t2[2:w2]), " (", round(100*as.numeric(sum(t2[2:w2])/nrow(love2)), 1), "%)"),
                   paste0(sum(t3[2:w3]), " (", round(100*as.numeric(sum(t3[2:w3])/nrow(love3)), 1), "%)")
                 ),
                 gap2 = c(
                   paste0(sum(t1[(w1+1):length(t1)]), " (", round(100*as.numeric(sum(t1[(w1+1):length(t1)])/nrow(love1)), 1), "%)"),
                   paste0(sum(t2[(w2+1):length(t2)]), " (", round(100*as.numeric(sum(t2[(w2+1):length(t2)])/nrow(love2)), 1), "%)"),
                   paste0(sum(t3[(w3+1):length(t3)]), " (", round(100*as.numeric(sum(t3[(w3+1):length(t3)])/nrow(love3)), 1), "%)")
                 )
                 )
write.csv(df, "gap_distribution.csv", row.names = F)
df

##   study   n        gap0        gap1      gap2
## 1     1 234  91 (38.9%)   124 (53%) 19 (8.1%)
## 2     2 190  78 (41.1%) 108 (56.8%)  4 (2.1%)
## 3     3 696 377 (54.2%) 266 (38.2%) 53 (7.6%)

Median gap between highest and second highest love language for those who have a primary language:

median(love1_primary$gap) # Study 1

## [1] 0.225

median(love2_primary$gap) # Study 2

## [1] 0.2

median(love3_primary$gap) # Study 3

## [1] 0.25

Median gap between highest and lowest love language

Study 1:

median(love1$gap5)

## [1] 1

sum(love1$gap5 <= 1)

## [1] 127

sum(love1$gap5 <= 1)/nrow(love1)

## [1] 0.542735

sum(love1$gap5 <= 2)

## [1] 209

sum(love1$gap5 <= 2)/nrow(love1)

## [1] 0.8931624

Study 2:

median(love2$gap5)

## [1] 1.1

sum(love2$gap5 <= 1)

## [1] 91

sum(love2$gap5 <= 1)/nrow(love2)

## [1] 0.4789474

sum(love2$gap5 <= 2)

## [1] 159

sum(love2$gap5 <= 2)/nrow(love2)

## [1] 0.8368421

Study 3:

median(love3$gap5)

## [1] 1

sum(love3$gap5 <= 1)

## [1] 366

sum(love3$gap5 <= 1)/nrow(love3)

## [1] 0.5258621

sum(love3$gap5 <= 2)

## [1] 593

sum(love3$gap5 <= 2)/nrow(love3)

## [1] 0.8520115

Primary Love Languages

Study 1:

summary(factor(love1_primary$R1))

##   gifts quality service   touch   words 
##      15      51      27      24      26

round(summary(factor(love1_primary$R1))/nrow(love1_primary), 2)

##   gifts quality service   touch   words 
##    0.10    0.36    0.19    0.17    0.18

Study 2:

summary(factor(love2_primary$R1))

##   gifts quality service   touch   words 
##      16      50       3      11      32

round(summary(factor(love2_primary$R1))/nrow(love2_primary), 2)

##   gifts quality service   touch   words 
##    0.14    0.45    0.03    0.10    0.29

Study 3:

summary(factor(love3_primary$R1))

##   gifts quality service   touch   words 
##      15      99      68      42      95

round(summary(factor(love3_primary$R1))/nrow(love3_primary), 2)

##   gifts quality service   touch   words 
##    0.05    0.31    0.21    0.13    0.30

Language and satisfaction scores

Means, SDs, medians, and alphas

fMSD <- function(x){
  return(paste0(round(mean(x, na.rm=T), 2), " (", round(sd(x, na.rm=T), 2), ")"))
}
fMed <- function(x){
  return(round(median(x, na.rm=T), 2))
}
df <- data.frame(language = names(love3)[c(w3_LL, w3_SLL, w3_sat, w3_loved)],
                 M_SD1 = c(as.vector(apply(love1[,c(w1_LL, w1_SLL, w1_sat)], 2, fMSD)), NA), 
                 Med1 = c(as.vector(apply(love1[,c(w1_LL, w1_SLL, w1_sat)], 2, fMed)), NA), 
                 alpha1 = c(alphas1$alpha, NA),
                 M_SD2 = c(as.vector(apply(love2[,c(w2_LL, w2_SLL, w2_sat)], 2, fMSD)), NA), 
                 Med2 = c(as.vector(apply(love2[,c(w2_LL, w2_SLL, w2_sat)], 2, fMed)), NA), 
                 alpha2 = c(alphas2$alpha, NA),
                 M_SD3 = as.vector(apply(love3[,c(w3_LL, w3_SLL, w3_sat, w3_loved)], 2, fMSD)), 
                 Med3 = as.vector(apply(love3[,c(w3_LL, w3_SLL, w3_sat, w3_loved)], 2, fMed)), 
                 alpha3 = c(alphas3$alpha, NA)
)
write.csv(df, "summary_allvars.csv", row.names = F)
table <- kable_styling(kbl(df, format = "html", booktabs = TRUE))
scroll_box(table, width = "100%", height = "100%")

language	M_SD1	Med1	alpha1	M_SD2	Med2	alpha2	M_SD3	Med3	alpha3
words	4.32 (0.68)	4.50	0.90	4.52 (0.53)	4.60	0.89	4.25 (0.94)	4.50	0.89
touch	4.18 (0.77)	4.33	0.88	4.03 (0.81)	4.14	0.87	3.81 (1.15)	4.00	0.91
service	4.29 (0.65)	4.40	0.81	3.98 (0.92)	4.20	0.84	4.18 (0.89)	4.50	0.88
gifts	4.03 (0.8)	4.20	0.82	4.31 (0.77)	4.60	0.85	3.76 (1.08)	4.00	0.87
quality	4.54 (0.55)	4.80	0.82	4.66 (0.47)	4.80	0.79	4.3 (0.82)	4.50	0.88
words_sat	4.22 (0.83)	4.38	0.93	4.49 (0.64)	4.80	0.92	3.96 (1.15)	4.25	0.92
touch_sat	4.21 (0.8)	4.50	0.87	4.14 (0.84)	4.43	0.89	3.82 (1.14)	4.00	0.92
service_sat	4.04 (0.92)	4.30	0.88	3.77 (0.89)	3.80	0.84	3.91 (1.11)	4.25	0.91
gifts_sat	3.73 (0.92)	3.80	0.86	3.99 (0.94)	4.20	0.87	3.7 (1.12)	4.00	0.91
quality_sat	4.28 (0.83)	4.60	0.87	4.4 (0.68)	4.60	0.79	4.09 (0.98)	4.25	0.89
sat	16.02 (4.51)	17.00	0.95	16.16 (4.07)	17.00	0.91	14.19 (5.91)	16.00	0.95
loved	NA	NA	NA	NA	NA	NA	7.03 (2.38)	7.00	NA

Correlations

Correlations among love languages

rs1 <- matrix(nrow = 5, ncol = 4)
rs2 <- matrix(nrow = 5, ncol = 4)
rs3 <- matrix(nrow = 5, ncol = 4)

for(i in 2:5){
  for(j in 1:(i-1)){
    aux1 <- round(rfun(love1[,c(w1_LL[i], w1_LL[j])]), 2)
    aux2 <- round(bcaCI(love1[,c(w1_LL[i], w1_LL[j])]), 2)
    rs1[i,j] <- paste0(aux1, " [", aux2[1], ", ", aux2[2], "]")
    
    aux1 <- round(rfun(love2[,c(w2_LL[i], w2_LL[j])]), 2)
    aux2 <- round(bcaCI(love2[,c(w2_LL[i], w2_LL[j])]), 2)
    rs2[i,j] <- paste0(aux1, " [", aux2[1], ", ", aux2[2], "]")
    
    aux1 <- round(rfun(love3[,c(w3_LL[i], w3_LL[j])]), 2)
    aux2 <- round(bcaCI(love3[,c(w3_LL[i], w3_LL[j])]), 2)
    rs3[i,j] <- paste0(aux1, " [", aux2[1], ", ", aux2[2], "]")
  }
}

rs <- cbind(paste0(c("1. ", "2. ", "3. ", "4. ", "5. "), names(love1)[w1_LL]), rs1, rs2, rs3)
rs <- as.data.frame(rs)
names(rs) <- c("Language", rep(1:4, 3))
write.csv(rs, paste0(cor_type, "_cor_LL.csv"), row.names = F)

Studies 1-3:

rs <- read.csv(paste0(cor_type, "_cor_LL.csv"))
names(rs) <- c("Language", rep(1:4, 3))
table <- kable_styling(kbl(rs, format = "html", booktabs = TRUE))
scroll_box(table, width = "100%", height = "100%")

Language	1	2	3	4	1	2	3	4	1	2	3	4
words	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
touch	0.64 [0.54, 0.73]	NA	NA	NA	0.48 [0.36, 0.61]	NA	NA	NA	0.61 [0.54, 0.67]	NA	NA	NA
service	0.41 [0.26, 0.56]	0.24 [0.09, 0.4]	NA	NA	0.51 [0.38, 0.62]	0.33 [0.19, 0.46]	NA	NA	0.72 [0.66, 0.77]	0.53 [0.46, 0.59]	NA	NA
gifts	0.51 [0.39, 0.61]	0.35 [0.21, 0.48]	0.51 [0.39, 0.63]	NA	0.65 [0.54, 0.75]	0.35 [0.2, 0.49]	0.57 [0.45, 0.69]	NA	0.69 [0.64, 0.73]	0.62 [0.55, 0.67]	0.7 [0.64, 0.74]	NA
quality	0.61 [0.51, 0.71]	0.53 [0.41, 0.64]	0.44 [0.31, 0.59]	0.48 [0.36, 0.59]	0.66 [0.55, 0.78]	0.34 [0.2, 0.5]	0.54 [0.42, 0.66]	0.59 [0.46, 0.73]	0.74 [0.68, 0.79]	0.6 [0.53, 0.65]	0.69 [0.62, 0.74]	0.67 [0.62, 0.72]

Correlations among satisfaction with love languages

rs1 <- matrix(nrow = 5, ncol = 4)
rs2 <- matrix(nrow = 5, ncol = 4)
rs3 <- matrix(nrow = 5, ncol = 4)

for(i in 2:5){
  for(j in 1:(i-1)){
    aux1 <- round(rfun(love1[,c(w1_SLL[i], w1_SLL[j])]), 2)
    aux2 <- round(bcaCI(love1[,c(w1_SLL[i], w1_SLL[j])]), 2)
    rs1[i,j] <- paste0(aux1, " [", aux2[1], ", ", aux2[2], "]")
    
    aux1 <- round(rfun(love2[,c(w2_SLL[i], w2_SLL[j])]), 2)
    aux2 <- round(bcaCI(love2[,c(w2_SLL[i], w2_SLL[j])]), 2)
    rs2[i,j] <- paste0(aux1, " [", aux2[1], ", ", aux2[2], "]")
    
    aux1 <- round(rfun(love3[,c(w3_SLL[i], w3_SLL[j])]), 2)
    aux2 <- round(bcaCI(love3[,c(w3_SLL[i], w3_SLL[j])]), 2)
    rs3[i,j] <- paste0(aux1, " [", aux2[1], ", ", aux2[2], "]")
  }
}

rs <- cbind(paste0(c("1. ", "2. ", "3. ", "4. ", "5. "), names(love1)[w1_SLL]), rs1, rs2, rs3)
rs <- as.data.frame(rs)
names(rs) <- c("Language", rep(1:4, 3))
write.csv(rs, paste0(cor_type, "_cor_SLL.csv"), row.names = F)

Studies 1-3:

rs <- read.csv(paste0(cor_type, "_cor_SLL.csv"))
names(rs) <- c("Language", rep(1:4, 3))
table <- kable_styling(kbl(rs, format = "html", booktabs = TRUE))
scroll_box(table, width = "100%", height = "100%")

Language	1	2	3	4	1	2	3	4	1	2	3	4
words_sat	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
touch_sat	0.78 [0.72, 0.84]	NA	NA	NA	0.59 [0.47, 0.69]	NA	NA	NA	0.75 [0.7, 0.79]	NA	NA	NA
service_sat	0.59 [0.45, 0.69]	0.53 [0.41, 0.63]	NA	NA	0.45 [0.33, 0.56]	0.47 [0.32, 0.59]	NA	NA	0.81 [0.77, 0.84]	0.68 [0.62, 0.72]	NA	NA
gifts_sat	0.6 [0.5, 0.69]	0.52 [0.41, 0.63]	0.69 [0.6, 0.76]	NA	0.55 [0.44, 0.64]	0.41 [0.29, 0.52]	0.64 [0.55, 0.72]	NA	0.76 [0.71, 0.79]	0.71 [0.66, 0.76]	0.74 [0.69, 0.78]	NA
quality_sat	0.71 [0.59, 0.8]	0.68 [0.59, 0.76]	0.7 [0.61, 0.78]	0.63 [0.53, 0.71]	0.68 [0.54, 0.77]	0.56 [0.43, 0.66]	0.57 [0.47, 0.65]	0.63 [0.53, 0.71]	0.84 [0.8, 0.86]	0.72 [0.67, 0.76]	0.8 [0.76, 0.83]	0.74 [0.7, 0.78]

Correlations between relationship satisfaction and partner satisfaction with love languages

rs1 <- matrix(nrow = 5, ncol = 2)
rs2 <- matrix(nrow = 5, ncol = 2)
rs3 <- matrix(nrow = 5, ncol = 2)
rs4 <- matrix(nrow = 5, ncol = 2)

for(i in 1:5){
  aux1 <- round(rfun(love1[,c(w1_sat, w1_SLL[i])]), 2)
  aux2 <- round(bcaCI(love1[,c(w1_sat, w1_SLL[i])]), 2)
  rs1[i,1] <- aux1
  rs1[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")

  aux1 <- round(rfun(love2[,c(w2_sat, w2_SLL[i])]), 2)
  aux2 <- round(bcaCI(love2[,c(w2_sat, w2_SLL[i])]), 2)
  rs2[i,1] <- aux1
  rs2[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")

  aux1 <- round(rfun(love3[,c(w3_sat, w3_SLL[i])]), 2)
  aux2 <- round(bcaCI(love3[,c(w3_sat, w3_SLL[i])]), 2)
  rs3[i,1] <- aux1
  rs3[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")

  aux1 <- round(rfun(love3[,c(w3_loved, w3_SLL[i])]), 2)
  aux2 <- round(bcaCI(love3[,c(w3_loved, w3_SLL[i])]), 2)
  rs4[i,1] <- aux1
  rs4[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")
}

rs_SLL_sat <- cbind(names(love1)[w1_LL], rs1, rs2, rs3, rs4)
rs_SLL_sat <- as.data.frame(rs_SLL_sat)
names(rs_SLL_sat) <- c("Sat. w/", "sat_1", "CI1", "sat_2", "CI2", "sat_3", "CI3", "loved_3", "CI4")

Correlations between relationship satisfaction and partner satisfaction with ranked love languages

rs1 <- matrix(nrow = 5, ncol = 2)
rs2 <- matrix(nrow = 5, ncol = 2)
rs3 <- matrix(nrow = 5, ncol = 2)
rs4 <- matrix(nrow = 5, ncol = 2)

for(i in 1:5){
  aux1 <- round(rfun(love1_primary[,c(w1_sat, w1_RSLL[i])]), 2)
  aux2 <- round(bcaCI(love1_primary[,c(w1_sat, w1_RSLL[i])]), 2)
  rs1[i,1] <- aux1
  rs1[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")
  
  aux1 <- round(rfun(love2_primary[,c(w2_sat, w2_RSLL[i])]), 2)
  aux2 <- round(bcaCI(love2_primary[,c(w2_sat, w2_RSLL[i])]), 2)
  rs2[i,1] <- aux1
  rs2[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")
  
  aux1 <- round(rfun(love3_primary[,c(w3_sat, w3_RSLL[i])]), 2)
  aux2 <- round(bcaCI(love3_primary[,c(w3_sat, w3_RSLL[i])]), 2)
  rs3[i,1] <- aux1
  rs3[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")
  
  aux1 <- round(rfun(love3_primary[,c(w3_loved, w3_RSLL[i])]), 2)
  aux2 <- round(bcaCI(love3_primary[,c(w3_loved, w3_RSLL[i])]), 2)
  rs4[i,1] <- aux1
  rs4[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")
}

rs_RSLL_sat <- cbind(names(love1_primary)[w1_RSLL], rs1, rs2, rs3, rs4)
rs_RSLL_sat <- as.data.frame(rs_RSLL_sat)
names(rs_RSLL_sat) <- c("Sat. w/", "sat_1", "CI1", "sat_2", "CI2", "sat_3", "CI3", "loved_3", "CI4")

rs_SLL_RSLL_sat <- rbind(rs_SLL_sat, rs_RSLL_sat)
write.csv(rs_SLL_RSLL_sat, paste0(cor_type, "_cor_SLL_RSLL_sat.csv"), row.names = F)

Studies 1-3:

rs <- read.csv(paste0(cor_type, "_cor_SLL_RSLL_sat.csv"))
table <- kable_styling(kbl(rs, format = "html", booktabs = TRUE))
scroll_box(table, width = "100%", height = "100%")

Sat..w.	sat_1	CI1	sat_2	CI2	sat_3	CI3	loved_3	CI4
words	0.63	[0.52, 0.73]	0.51	[0.39, 0.62]	0.75	[0.7, 0.79]	0.71	[0.64, 0.76]
touch	0.57	[0.45, 0.69]	0.40	[0.25, 0.51]	0.67	[0.61, 0.72]	0.62	[0.55, 0.68]
service	0.51	[0.39, 0.62]	0.33	[0.2, 0.45]	0.68	[0.62, 0.72]	0.64	[0.57, 0.7]
gifts	0.45	[0.31, 0.57]	0.34	[0.2, 0.47]	0.62	[0.57, 0.67]	0.56	[0.48, 0.62]
quality	0.67	[0.57, 0.76]	0.43	[0.3, 0.55]	0.74	[0.69, 0.78]	0.70	[0.64, 0.76]
R1_sat	0.50	[0.33, 0.65]	0.36	[0.18, 0.53]	0.65	[0.56, 0.71]	0.62	[0.52, 0.7]
R2_sat	0.56	[0.41, 0.69]	0.25	[0.08, 0.41]	0.69	[0.62, 0.74]	0.65	[0.56, 0.72]
R3_sat	0.49	[0.32, 0.65]	0.33	[0.14, 0.53]	0.68	[0.6, 0.74]	0.66	[0.57, 0.74]
R4_sat	0.55	[0.4, 0.68]	0.24	[0.06, 0.41]	0.65	[0.57, 0.71]	0.55	[0.45, 0.64]
R5_sat	0.46	[0.3, 0.61]	0.24	[0.06, 0.42]	0.60	[0.52, 0.66]	0.55	[0.46, 0.63]

Multiple linear regressions

m1 <- lm(sat ~ R1_sat + R2_sat + R3_sat + R4_sat + R5_sat, data = love1)
s1 <- summary(m1)
b1 <- lm.beta(m1)

m2 <- lm(sat ~ R1_sat + R2_sat + R3_sat + R4_sat + R5_sat, data = love2)
s2 <- summary(m2)
b2 <- lm.beta(m2)

m3 <- lm(sat ~ R1_sat + R2_sat + R3_sat + R4_sat + R5_sat, data = love3)
s3 <- summary(m3)
b3 <- lm.beta(m3)

df <- data.frame(slope1 = m1$coefficients, beta1  = c(NA,lm.beta(m1)), v1 = c(NA,vif(m1)), p1 = as.vector(s1$coefficients[,4]),
                 slope2 = m2$coefficients, beta2  = c(NA,lm.beta(m2)), v2 = c(NA,vif(m2)), p2 = as.vector(s2$coefficients[,4]),
                 slope3 = m3$coefficients, beta3  = c(NA,lm.beta(m3)), v3 = c(NA,vif(m3)), p3 = as.vector(s3$coefficients[,4]))

table <- kable_styling(kbl(df, format = "html", booktabs = TRUE))
scroll_box(table, width = "100%", height = "100%")

	slope1	beta1	v1	p1	slope2	beta2	v2	p2	slope3	beta3	v3	p3
(Intercept)	-1.0526978	NA	NA	0.4107372	3.1725852	NA	NA	0.0680630	-3.8282857	NA	NA	0.0000000
R1_sat	0.3182205	0.0634867	3.548308	0.4923541	1.1938329	0.2366977	2.901560	0.0313270	0.7901199	0.1448390	6.159822	0.0160397
R2_sat	1.6029837	0.3113948	3.176103	0.0004430	0.2658874	0.0515820	2.558897	0.6152529	1.4052727	0.2580754	6.994139	0.0000603
R3_sat	0.5307554	0.0980017	3.139143	0.2602509	0.3625240	0.0703511	2.257156	0.4656533	1.1561886	0.2054282	5.041562	0.0001674
R4_sat	0.9411010	0.1729791	2.235470	0.0190884	0.4232926	0.0851655	1.770157	0.3189133	0.3804047	0.0683234	4.321183	0.1744156
R5_sat	0.7753574	0.1426748	1.921170	0.0368029	0.8848946	0.1786783	1.448177	0.0215405	0.8701826	0.1637651	2.779164	0.0000539

BCa confidence intervals for the differences in slopes

Study 1:

bcaCI_bdiff2(love1_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.6312561  0.1436849

bcaCI_bdiff3(love1_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.3425772  0.4483161

bcaCI_bdiff4(love1_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.5084307  0.1170655

bcaCI_bdiff5(love1_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.3675937  0.1864651

Study 2:

bcaCI_bdiff2(love2_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.1812834  0.5354500

bcaCI_bdiff3(love2_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.348506  0.407226

bcaCI_bdiff4(love2_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.1351096  0.5260197

bcaCI_bdiff5(love2_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.2453934  0.3943409

Study 3:

bcaCI_bdiff2(love3_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.3287226  0.1258311

bcaCI_bdiff3(love3_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.3203542  0.1698625

bcaCI_bdiff4(love3_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.1826610  0.2354015

bcaCI_bdiff5(love3_primary[,c("sat", "R1_sat", "R2_sat", "R3_sat", "R4_sat", "R5_sat")])

## [1] -0.1793375  0.1764113

Correlations between relationship satisfaction and partner satisfaction with ranked love languages for those who had a gap >= 0.75

rs1 <- matrix(nrow = 5, ncol = 2)
rs2 <- matrix(nrow = 5, ncol = 2)
rs3 <- matrix(nrow = 5, ncol = 2)
rs4 <- matrix(nrow = 5, ncol = 2)

for(i in 1:5){
  aux1 <- round(rfun(love1[love1$gap >= 0.75, c(w1_sat, w1_RSLL[i])]), 2)
  aux2 <- round(bcaCI(love1[love1$gap >= 0.75, c(w1_sat, w1_RSLL[i])]), 2)
  rs1[i,1] <- aux1
  rs1[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")
  
  aux1 <- round(rfun(love2[love2$gap >= 0.75, c(w2_sat, w2_RSLL[i])]), 2)
  aux2 <- round(bcaCI(love2[love2$gap >= 0.75, c(w2_sat, w2_RSLL[i])]), 2)
  rs2[i,1] <- aux1
  rs2[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")
  
  aux1 <- round(rfun(love3[love3$gap >= 0.75, c(w3_sat, w3_RSLL[i])]), 2)
  aux2 <- round(bcaCI(love3[love3$gap >= 0.75, c(w3_sat, w3_RSLL[i])]), 2)
  rs3[i,1] <- aux1
  rs3[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")
  
  aux1 <- round(rfun(love3[love3$gap >= 0.75, c(w3_loved, w3_RSLL[i])]), 2)
  aux2 <- round(bcaCI(love3[love3$gap >= 0.75, c(w3_loved, w3_RSLL[i])]), 2)
  rs4[i,1] <- aux1
  rs4[i,2] <- paste0("[", aux2[1], ", ", aux2[2], "]")
}

rs_RSLL_sat_75 <- cbind(names(love1)[w1_RSLL], rs1, rs2, rs3, rs4)
rs_RSLL_sat_75 <- as.data.frame(rs_RSLL_sat_75)
names(rs_RSLL_sat_75) <- c("Sat. w/", "sat_1", "CI1", "sat_2", "CI2", "sat_3", "CI3", "loved_3", "CI4")
write.csv(rs_RSLL_sat_75, paste0(cor_type, "_cor_RSLL_sat_75.csv"), row.names = F)

Studies 1-3:

rs <- read.csv(paste0(cor_type, "_cor_RSLL_sat_75.csv"))
table <- kable_styling(kbl(rs[,c(1, 6:9)], format = "html", booktabs = TRUE))
scroll_box(table, width = "100%", height = "100%")

Sat..w.	sat_3	CI3	loved_3	CI4
R1_sat	0.41	[0.1, 0.64]	0.33	[0.02, 0.59]
R2_sat	0.64	[0.4, 0.78]	0.61	[0.39, 0.75]
R3_sat	0.62	[0.38, 0.79]	0.59	[0.33, 0.79]
R4_sat	0.41	[0.18, 0.62]	0.36	[0.1, 0.61]
R5_sat	0.41	[0.15, 0.61]	0.40	[0.11, 0.63]

Difference between correlations of LL with rel.sat.

Study 1:

bcaCI_diff(love1[,c("sat", "words_sat", "touch_sat")])

## [1] -0.01868562  0.12979503

bcaCI_diff(love1[,c("sat", "words_sat", "service_sat")])

## [1] 0.02208073 0.22674968

bcaCI_diff(love1[,c("sat", "words_sat", "gifts_sat")])

## [1] 0.07780223 0.29854350

bcaCI_diff(love1[,c("sat", "words_sat", "quality_sat")])

## [1] -0.11480783  0.01850387

bcaCI_diff(love1[,c("sat", "touch_sat", "service_sat")])

## [1] -0.06092704  0.19443818

bcaCI_diff(love1[,c("sat", "touch_sat", "gifts_sat")])

## [1] 0.005715701 0.263696378

bcaCI_diff(love1[,c("sat", "touch_sat", "quality_sat")])

## [1] -0.19973433 -0.01481146

bcaCI_diff(love1[,c("sat", "service_sat", "gifts_sat")])

## [1] -0.04099819  0.17121729

bcaCI_diff(love1[,c("sat", "service_sat", "quality_sat")])

## [1] -0.26667872 -0.07038792

bcaCI_diff(love1[,c("sat", "gifts_sat", "quality_sat")])

## [1] -0.3557079 -0.1263532

Study 2:

bcaCI_diff(love2[,c("sat", "words_sat", "touch_sat")])

## [1] 0.002187748 0.247169796

bcaCI_diff(love2[,c("sat", "words_sat", "service_sat")])

## [1] 0.04569269 0.30819943

bcaCI_diff(love2[,c("sat", "words_sat", "gifts_sat")])

## [1] 0.0487364 0.2993381

bcaCI_diff(love2[,c("sat", "words_sat", "quality_sat")])

## [1] -0.01561786  0.17765938

bcaCI_diff(love2[,c("sat", "touch_sat", "service_sat")])

## [1] -0.08215797  0.20537626

bcaCI_diff(love2[,c("sat", "touch_sat", "gifts_sat")])

## [1] -0.09074362  0.21516761

bcaCI_diff(love2[,c("sat", "touch_sat", "quality_sat")])

## [1] -0.14374866  0.08270381

bcaCI_diff(love2[,c("sat", "service_sat", "gifts_sat")])

## [1] -0.09773473  0.09136529

bcaCI_diff(love2[,c("sat", "service_sat", "quality_sat")])

## [1] -0.22294898  0.02323273

bcaCI_diff(love2[,c("sat", "gifts_sat", "quality_sat")])

## [1] -0.22556318  0.02591163

Study 3:

bcaCI_diff(love3[,c("sat", "words_sat", "touch_sat")])

## [1] 0.03680919 0.11502458

bcaCI_diff(love3[,c("sat", "words_sat", "service_sat")])

## [1] 0.03720037 0.10582826

bcaCI_diff(love3[,c("sat", "words_sat", "gifts_sat")])

## [1] 0.08330586 0.16470389

bcaCI_diff(love3[,c("sat", "words_sat", "quality_sat")])

## [1] -0.02141846  0.03565350

bcaCI_diff(love3[,c("sat", "touch_sat", "service_sat")])

## [1] -0.04990263  0.04071102

bcaCI_diff(love3[,c("sat", "touch_sat", "gifts_sat")])

## [1] 0.003358757 0.093705061

bcaCI_diff(love3[,c("sat", "touch_sat", "quality_sat")])

## [1] -0.11146010 -0.02767645

bcaCI_diff(love3[,c("sat", "service_sat", "gifts_sat")])

## [1] 0.01027086 0.09549495

bcaCI_diff(love3[,c("sat", "service_sat", "quality_sat")])

## [1] -0.09755535 -0.02976621

bcaCI_diff(love3[,c("sat", "gifts_sat", "quality_sat")])

## [1] -0.15620639 -0.07816566

Study 3 (loved):

bcaCI_diff(love3[,c("loved", "words_sat", "touch_sat")])

## [1] 0.04366984 0.13693644

bcaCI_diff(love3[,c("loved", "words_sat", "service_sat")])

## [1] 0.02631145 0.10750488

bcaCI_diff(love3[,c("loved", "words_sat", "gifts_sat")])

## [1] 0.1062711 0.1990660

bcaCI_diff(love3[,c("loved", "words_sat", "quality_sat")])

## [1] -0.03348726  0.04136057

bcaCI_diff(love3[,c("loved", "touch_sat", "service_sat")])

## [1] -0.07666592  0.03189763

bcaCI_diff(love3[,c("loved", "touch_sat", "gifts_sat")])

## [1] 0.0123186 0.1159527

bcaCI_diff(love3[,c("loved", "touch_sat", "quality_sat")])

## [1] -0.13908913 -0.03505066

bcaCI_diff(love3[,c("loved", "service_sat", "gifts_sat")])

## [1] 0.03701796 0.14175306

bcaCI_diff(love3[,c("loved", "service_sat", "quality_sat")])

## [1] -0.10449851 -0.02192486

bcaCI_diff(love3[,c("loved", "gifts_sat", "quality_sat")])

## [1] -0.2001494 -0.1019986

Difference between ranked correlations with the highest one

Study 1:

bcaCI_diff(love1_primary[,c("sat", "R1_sat", "R2_sat")])

## [1] -0.17548902  0.05566965

bcaCI_diff(love1_primary[,c("sat", "R1_sat", "R3_sat")])

## [1] -0.1195001  0.1568372

bcaCI_diff(love1_primary[,c("sat", "R1_sat", "R4_sat")])

## [1] -0.20389610  0.08812319

bcaCI_diff(love1_primary[,c("sat", "R1_sat", "R5_sat")])

## [1] -0.1302327  0.2040621

Study 2:

bcaCI_diff(love2_primary[,c("sat", "R1_sat", "R2_sat")])

## [1] -0.0322368  0.3061170

bcaCI_diff(love2_primary[,c("sat", "R1_sat", "R3_sat")])

## [1] -0.1495357  0.1803473

bcaCI_diff(love2_primary[,c("sat", "R1_sat", "R4_sat")])

## [1] -0.09163313  0.32224737

bcaCI_diff(love2_primary[,c("sat", "R1_sat", "R5_sat")])

## [1] -0.1008771  0.3639082

Study 3:

bcaCI_diff(love3_primary[,c("sat", "R1_sat", "R2_sat")])

## [1] -0.1044898  0.0108608

bcaCI_diff(love3_primary[,c("sat", "R1_sat", "R3_sat")])

## [1] -0.10497510  0.03537002

bcaCI_diff(love3_primary[,c("sat", "R1_sat", "R4_sat")])

## [1] -0.07972161  0.07036784

bcaCI_diff(love3_primary[,c("sat", "R1_sat", "R5_sat")])

## [1] -0.03233121  0.13301675

Study 3 (loved):

bcaCI_diff(love3_primary[,c("loved", "R1_sat", "R2_sat")])

## [1] -0.10376546  0.04468955

bcaCI_diff(love3_primary[,c("loved", "R1_sat", "R3_sat")])

## [1] -0.13091757  0.04764712

bcaCI_diff(love3_primary[,c("loved", "R1_sat", "R4_sat")])

## [1] -0.01867238  0.16999695

bcaCI_diff(love3_primary[,c("loved", "R1_sat", "R5_sat")])

## [1] -0.02561841  0.16447501

Difference between highest ranked correlation and correlations for satisfaction with love languages

Study 1:

bcaCI_diff2(love1[,c("sat", "words_sat", "R1_sat", "gap")])

## [1] 0.01178609 0.26835210

bcaCI_diff2(love1[,c("sat", "touch_sat", "R1_sat", "gap")])

## [1] -0.0487941  0.2185092

bcaCI_diff2(love1[,c("sat", "service_sat", "R1_sat", "gap")])

## [1] -0.1204878  0.1695284

bcaCI_diff2(love1[,c("sat", "gifts_sat", "R1_sat", "gap")])

## [1] -0.2115404  0.1152374

bcaCI_diff2(love1[,c("sat", "quality_sat", "R1_sat", "gap")])

## [1] 0.05843837 0.31793302

Study 2:

bcaCI_diff2(love2[,c("sat", "words_sat", "R1_sat", "gap")])

## [1] -0.01878152  0.30600715

bcaCI_diff2(love2[,c("sat", "touch_sat", "R1_sat", "gap")])

## [1] -0.1840878  0.2255002

bcaCI_diff2(love2[,c("sat", "service_sat", "R1_sat", "gap")])

## [1] -0.1906957  0.1406524

bcaCI_diff2(love2[,c("sat", "gifts_sat", "R1_sat", "gap")])

## [1] -0.1876256  0.1596363

bcaCI_diff2(love2[,c("sat", "quality_sat", "R1_sat", "gap")])

## [1] -0.1086405  0.2203006

Study 3:

bcaCI_diff2(love3[,c("sat", "words_sat", "R1_sat", "gap")])

## [1] 0.03377412 0.18007316

bcaCI_diff2(love3[,c("sat", "touch_sat", "R1_sat", "gap")])

## [1] -0.04641595  0.10377898

bcaCI_diff2(love3[,c("sat", "service_sat", "R1_sat", "gap")])

## [1] -0.04026801  0.10903319

bcaCI_diff2(love3[,c("sat", "gifts_sat", "R1_sat", "gap")])

## [1] -0.09917962  0.06135141

bcaCI_diff2(love3[,c("sat", "quality_sat", "R1_sat", "gap")])

## [1] 0.02311635 0.17612389

Study 3 (loved):

bcaCI_diff2(love3[,c("loved", "words_sat", "R1_sat", "gap")])

## [1] 0.001388041 0.182330589

bcaCI_diff2(love3[,c("loved", "touch_sat", "R1_sat", "gap")])

## [1] -0.08734398  0.08981647

bcaCI_diff2(love3[,c("loved", "service_sat", "R1_sat", "gap")])

## [1] -0.06286536  0.11401403

bcaCI_diff2(love3[,c("loved", "gifts_sat", "R1_sat", "gap")])

## [1] -0.15724198  0.03485396

bcaCI_diff2(love3[,c("loved", "quality_sat", "R1_sat", "gap")])

## [1] -0.004886535  0.182801568

Relationship satisfaction for those with a primary LL and those without

Study 1:

tapply(love1$sat, love1$gap > 0, sd, na.rm = T)

##    FALSE     TRUE 
## 4.328879 4.609267

t.test(love1$sat ~ love1$gap > 0)

## 
##  Welch Two Sample t-test
## 
## data:  love1$sat by love1$gap > 0
## t = 1.4514, df = 200.55, p-value = 0.1482
## alternative hypothesis: true difference in means between group FALSE and group TRUE is not equal to 0
## 95 percent confidence interval:
##  -0.3098998  2.0381716
## sample estimates:
## mean in group FALSE  mean in group TRUE 
##            16.54945            15.68531

Study 2:

tapply(love2$sat, love2$gap > 0, sd, na.rm = T)

##    FALSE     TRUE 
## 4.268327 3.881189

t.test(love2$sat ~ love2$gap > 0)

## 
##  Welch Two Sample t-test
## 
## data:  love2$sat by love2$gap > 0
## t = 1.8887, df = 155.45, p-value = 0.0608
## alternative hypothesis: true difference in means between group FALSE and group TRUE is not equal to 0
## 95 percent confidence interval:
##  -0.05258015  2.34424681
## sample estimates:
## mean in group FALSE  mean in group TRUE 
##            16.83333            15.68750

Study 3:

tapply(love3$sat, love3$gap > 0, sd, na.rm = T)

##    FALSE     TRUE 
## 5.920162 5.717532

t.test(love3$sat ~ love3$gap > 0)

## 
##  Welch Two Sample t-test
## 
## data:  love3$sat by love3$gap > 0
## t = 4.4825, df = 681.99, p-value = 8.652e-06
## alternative hypothesis: true difference in means between group FALSE and group TRUE is not equal to 0
## 95 percent confidence interval:
##  1.113653 2.849694
## sample estimates:
## mean in group FALSE  mean in group TRUE 
##            15.10080            13.11912

Study 3 (loved):

tapply(love3$loved, love3$gap > 0, sd, na.rm = T)

##    FALSE     TRUE 
## 2.456876 2.266051

t.test(love3$loved ~ love3$gap > 0)

## 
##  Welch Two Sample t-test
## 
## data:  love3$loved by love3$gap > 0
## t = 1.5547, df = 539.96, p-value = 0.1206
## alternative hypothesis: true difference in means between group FALSE and group TRUE is not equal to 0
## 95 percent confidence interval:
##  -0.08198099  0.70429610
## sample estimates:
## mean in group FALSE  mean in group TRUE 
##            7.163009            6.851852

Gender comparisons

df <- data.frame(PW1 = rep(NA,5), PM1 = rep(NA,5), PW2 = rep(NA,5), PM2 = rep(NA,5), PW3 = rep(NA,5), PM3 = rep(NA,5))

w <- which(love1_primary$gender %in% c("Woman", "Man"))
t1 <- table(love1_primary$R1[w], love1_primary$gender[w])
tp <- round(prop.table(t1, 2), 2)
df$PW1 <- paste0(t1[,2], " (", tp[,2], "%)")
df$PM1 <- paste0(t1[,1], " (", tp[,1], "%)")

w <- which(love2_primary$gender %in% c("Woman", "Man"))
t2 <- table(love2_primary$R1[w], love2_primary$gender[w])
tp <- round(prop.table(t2, 2), 2)
df$PW2 <- paste0(t2[,2], " (", tp[,2], "%)")
df$PM2 <- paste0(t2[,1], " (", tp[,1], "%)")

w <- which(love3_primary$gender %in% c("Woman", "Man"))
t3 <- table(love3_primary$R1[w], love3_primary$gender[w])
tp <- round(prop.table(t3, 2), 2)
df$PW3 <- paste0(t3[,2], " (", tp[,2], "%)")
df$PM3 <- paste0(t3[,1], " (", tp[,1], "%)")

df <- cbind(row.names(t3), df)
names(df)[1] <- "Language"
write.csv(df, "gender_proportions_csv", row.names = F)

table <- kable_styling(kbl(df, format = "html", booktabs = TRUE))
scroll_box(table, width = "100%", height = "100%")

Language	PW1	PM1	PW2	PM2	PW3	PM3
gifts	14 (0.12%)	1 (0.04%)	13 (0.15%)	3 (0.12%)	11 (0.05%)	4 (0.05%)
quality	41 (0.37%)	8 (0.3%)	40 (0.47%)	10 (0.38%)	69 (0.29%)	29 (0.37%)
service	20 (0.18%)	7 (0.26%)	2 (0.02%)	1 (0.04%)	54 (0.23%)	14 (0.18%)
touch	18 (0.16%)	6 (0.22%)	5 (0.06%)	6 (0.23%)	29 (0.12%)	13 (0.16%)
words	19 (0.17%)	5 (0.19%)	25 (0.29%)	6 (0.23%)	74 (0.31%)	19 (0.24%)

Fisher’s exact tests for gender

Study 1:

fisher.test(t1)

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

Study 2:

fisher.test(t2)

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

Study 3:

fisher.test(t3)

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