Clean the Data
#Select only the columns we care about and call it "Cleaned_CompositeSurvey"
Cleaned_CompositeSurvey <- Raw_CompositeSurvey %>%
dplyr::select(5, 6, 7:50) %>% #Select the 46 columns that are relevant for my study
rename(Age = 1,
Race = 2,
Gender = 3,
GenderOther = 4,
IdealRelDescription = 5,
IdealRel_Companionate = 6,
IdealRel_Passionate = 7,
IdealRel_Calm = 8,
IdealRel_Happy = 9,
IdealRel_Excited = 10,
NumPrevRel = 11,
CurrentRel = 12,
RelDuration = 13,
ActualRel_LAP = 14,
ActualRel_HAP = 15,
ActualRel_Calm = 16,
ActualRel_Happy = 17,
ActualRel_Excited = 18,
IOS = 19,
RAS_1 = 20,
RAS_2 = 21,
RAS_3 = 22,
RAS_4 = 23,
RAS_5 = 24,
RAS_6 = 25,
RAS_7 = 26,
Actual_enthus = 27,
Actual_happy = 28,
Actual_calm = 29,
Actual_inactive = 30,
Actual_bored = 31,
Actual_sad = 32,
Actual_anxious = 33,
Actual_aroused = 34,
Actual_excited = 35,
Actual_relaxed = 36,
Ideal_enthus = 37,
Ideal_happy = 38,
Ideal_calm = 39,
Ideal_inactive = 40,
Ideal_bored = 41,
Ideal_sad = 42,
Ideal_anxious = 43,
Ideal_aroused = 44,
Ideal_excited = 45,
Ideal_relaxed = 46)
#Compute the RAS score (mean) for each participant and call this new column mean_RAS
Cleaned_CompositeSurvey <- Cleaned_CompositeSurvey %>%
mutate(RAS_4 = 6 - RAS_4, RAS_7 = 6 - RAS_7) %>% #Reverese coded items
mutate(mean_RAS = rowMeans(dplyr::select(., contains("RAS")), na.rm = T)) #Compute mean
#Compute the ideal and actual affect scores for each participant and call these new columns Ideal_HAP, Ideal_LAP, Actual_HAP, and Actual_LAP
Cleaned_CompositeSurvey <- Cleaned_CompositeSurvey %>%
rowwise() %>%
mutate(Ideal_HAP = mean(c(Ideal_enthus, Ideal_excited), na.rm = T),
Ideal_LAP = mean(c(Ideal_calm, Ideal_relaxed), na.rm = T),
Actual_HAP = mean(c(Actual_enthus, Actual_excited), na.rm = T),
Actual_LAP = mean(c(Actual_calm, Actual_relaxed), na.rm = T))
Ipsatize ideal and actual affect scores
# Cleaned_CompositeSurvey <- Cleaned_CompositeSurvey %>%
# rowwise() %>%
# mutate(Ideal_Mean = mean(c(contains("Ideal_")), na.rm = T), #Calculate ideal affect mean
# Ideal_SD = sd(c(contains("Ideal_"), na.rm = T))) %>% #Calculate ideal affect SD
# mutate(Ideal_enthus_i = (Ideal_enthus - Ideal_Mean)/Ideal_SD, #Ipsatize Ideal_enthus
# Ideal_excited_i = (Ideal_excited - Ideal_Mean)/Ideal_SD, #Ipsatize Ideal_excited
# Ideal_calm_i = (Ideal_calm - Ideal_Mean)/Ideal_SD, #Ipsatize Ideal_calm
# Ideal_relaxed_i = (Ideal_relaxed - Ideal_Mean)/Ideal_SD) %>% #Ipsatize Ideal_relaxed
# mutate(Ideal_HAP_i = mean(c(Ideal_enthus_i, Ideal_excited_i), na.rm = T), #Compute ipsatized HAP
# Ideal_LAP_i = mean(c(Ideal_calm_i, Ideal_relaxed_i), na.rm = T)) #Compute ipsatized HAP
#
# #Do the same (ipsatize) for the actual affect scores
# Cleaned_CompositeSurvey <- Cleaned_CompositeSurvey %>%
# rowwise() %>%
# mutate(Actual_Mean = mean(c(contains("Actual_"), na.rm = T)), #Calculate actual affect mean
# Actual_SD = sd(c(contains("Actual_"), na.rm = T))) %>% #Calculate actual affect SD
# mutate(Actual_enthus_i = (Actual_enthus - Actual_Mean)/Actual_SD, #Ipsatize Actual_enthus
# Actual_excited_i = (Actual_excited - Actual_Mean)/Actual_SD, #Ipsatize Actual_excited
# Actual_calm_i = (Actual_calm - Actual_Mean)/Actual_SD, #Ipsatize Actual_calm
# Actual_relaxed_i = (Actual_relaxed - Actual_Mean)/Actual_SD) %>% #Ipsatize Actual_relaxed
# mutate(Actual_HAP_i = mean(c(Actual_enthus_i, Actual_excited_i), na.rm = T), #Compute ips HAP
# Actual_LAP_i = mean(c(Actual_calm_i, Actual_relaxed_i), na.rm = T)) #Compute ipsatized HAP
#Long way
Ipsatized_CompositeSurvey <- Cleaned_CompositeSurvey %>%
rowwise() %>%
mutate(Ideal_Mean = mean(c(Ideal_enthus, Ideal_happy, Ideal_calm, Ideal_inactive, Ideal_bored, Ideal_sad, Ideal_anxious, Ideal_aroused, Ideal_excited, Ideal_relaxed), na.rm = T), #Calculate ideal affect mean
Ideal_SD = sd(c(Ideal_enthus,Ideal_happy, Ideal_calm, Ideal_inactive, Ideal_bored, Ideal_sad, Ideal_anxious, Ideal_aroused, Ideal_excited, Ideal_relaxed), na.rm = T)) %>% #Calculate ideal affect SD
mutate(Ideal_enthus_i = (Ideal_enthus - Ideal_Mean)/Ideal_SD, #Ipsatize Ideal_enthus
Ideal_excited_i = (Ideal_excited - Ideal_Mean)/Ideal_SD, #Ipsatize Ideal_excited
Ideal_calm_i = (Ideal_calm - Ideal_Mean)/Ideal_SD, #Ipsatize Ideal_calm
Ideal_relaxed_i = (Ideal_relaxed - Ideal_Mean)/Ideal_SD) %>% #Ipsatize Ideal_relaxed
mutate(Ideal_HAP_i = mean(c(Ideal_enthus_i, Ideal_excited_i), na.rm = T), #Compute ipsatized HAP
Ideal_LAP_i = mean(c(Ideal_calm_i, Ideal_relaxed_i), na.rm = T)) #Compute ipsatized HAP
#Do the same (ipsatize) for the actual affect scores
Ipsatized_CompositeSurvey <- Ipsatized_CompositeSurvey %>%
rowwise() %>%
mutate(Actual_Mean = mean(c(Actual_enthus, Actual_happy, Actual_calm, Actual_inactive, Actual_bored, Actual_sad, Actual_anxious, Actual_aroused, Actual_excited, Actual_relaxed), na.rm = T), #Calculate actual affect mean
Actual_SD = sd(c(Actual_enthus, Actual_happy, Actual_calm, Actual_inactive, Actual_bored, Actual_sad, Actual_anxious, Actual_aroused, Actual_excited, Actual_relaxed), na.rm = T)) %>% #Calculate actual affect SD
mutate(Actual_enthus_i = (Actual_enthus - Actual_Mean)/Actual_SD, #Ipsatize Actual_enthus
Actual_excited_i = (Actual_excited - Actual_Mean)/Actual_SD, #Ipsatize Actual_excited
Actual_calm_i = (Actual_calm - Actual_Mean)/Actual_SD, #Ipsatize Actual_calm
Actual_relaxed_i = (Actual_relaxed - Actual_Mean)/Actual_SD) %>% #Ipsatize Actual_relaxed
mutate(Actual_HAP_i = mean(c(Actual_enthus_i, Actual_excited_i), na.rm = T), #Compute ips HAP
Actual_LAP_i = mean(c(Actual_calm_i, Actual_relaxed_i), na.rm = T)) %>% #Compute ipsatized HAP
ungroup()
#Only retain the columns that are necessary
Compact_CompositeSurvey <- Ipsatized_CompositeSurvey %>%
dplyr::select(-(c(contains("RAS_")))) %>% #Remove the individual RAS items
dplyr::select(-(c(contains("SD")))) %>%
dplyr::select(-(Actual_enthus:Ideal_relaxed)) %>%
dplyr::select(-(Ideal_enthus_i:Ideal_relaxed_i)) %>%
dplyr::select(-(Actual_enthus_i:Actual_relaxed_i)) %>%
dplyr::select(-c(Ideal_Mean, Actual_Mean))
Label factors
#Race
Compact_CompositeSurvey$Race <- factor(Compact_CompositeSurvey$Race,
levels = c(1,2,3,4,5,6),
labels = c("Asian / Asian American", "Black / African American", "Hispanic / Latino/a", "Native American / American Indian", "Other", "White / European American"))
#Relationship status
Compact_CompositeSurvey$CurrentRel <- factor(Compact_CompositeSurvey$CurrentRel,
levels = c(1,2),
labels = c("Partnered", "Single"))
#Gender
Compact_CompositeSurvey$Gender <- factor(Compact_CompositeSurvey$Gender,
levels = c(1,2),
labels = c("Male", "Female"))
Overall data view
#Get overall sense of variable types and missing values in cleaned data
visdat::vis_dat(Compact_CompositeSurvey)
glimpse(Compact_CompositeSurvey)
## Observations: 151
## Variables: 28
## $ Age <dbl> 18, 18, 19, 19, 19, 18, 18, 19, 19, 19, 19…
## $ Race <fct> Asian / Asian American, White / European A…
## $ Gender <fct> Female, Female, Female, Female, Female, Fe…
## $ GenderOther <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
## $ IdealRelDescription <chr> "An ideal relationship would be built on t…
## $ IdealRel_Companionate <dbl> 6, 6, 6, 7, 7, 6, 7, 7, 7, 7, 7, 7, 6, 6, …
## $ IdealRel_Passionate <dbl> 5, 7, 5, 6, 5, 7, 5, 7, 5, 5, 5, 3, 4, 6, …
## $ IdealRel_Calm <dbl> 82, 50, 80, 85, 72, 35, 70, 100, 68, 65, 7…
## $ IdealRel_Happy <dbl> 95, 100, 90, 100, 81, 90, 100, 100, 100, 1…
## $ IdealRel_Excited <dbl> 94, 90, 75, 95, 73, 78, 81, 80, 84, 85, 60…
## $ NumPrevRel <dbl> 4, 2, 0, 4, 5, 2, 0, 1, 1, 0, 0, 1, 1, 5, …
## $ CurrentRel <fct> NA, NA, NA, Partnered, NA, NA, NA, NA, NA,…
## $ RelDuration <dbl> NA, NA, NA, 16, NA, NA, NA, NA, NA, NA, NA…
## $ ActualRel_LAP <dbl> NA, NA, NA, 6, NA, NA, NA, NA, NA, NA, NA,…
## $ ActualRel_HAP <dbl> NA, NA, NA, 5, NA, NA, NA, NA, NA, NA, NA,…
## $ ActualRel_Calm <dbl> NA, NA, NA, 70, NA, NA, NA, NA, NA, NA, NA…
## $ ActualRel_Happy <dbl> NA, NA, NA, 85, NA, NA, NA, NA, NA, NA, NA…
## $ ActualRel_Excited <dbl> NA, NA, NA, 75, NA, NA, NA, NA, NA, NA, NA…
## $ IOS <dbl> NA, NA, NA, 4, NA, NA, NA, NA, NA, NA, NA,…
## $ mean_RAS <dbl> NaN, NaN, NaN, 3.857143, NaN, NaN, NaN, Na…
## $ Ideal_HAP <dbl> 4.0, 3.5, 3.0, 4.0, 3.5, 3.0, 4.0, 4.0, 4.…
## $ Ideal_LAP <dbl> 5.0, 4.5, 4.0, 4.5, 4.0, 4.0, 4.5, 4.5, 3.…
## $ Actual_HAP <dbl> 2.5, 2.5, 2.0, 3.5, 3.5, 3.5, 3.5, 3.0, 4.…
## $ Actual_LAP <dbl> 4.0, 2.0, 4.0, 3.0, 3.5, 4.0, 3.0, 2.0, 4.…
## $ Ideal_HAP_i <dbl> 0.41105415, 0.39373078, 0.39391930, 0.6994…
## $ Ideal_LAP_i <dbl> 0.9982744, 1.0499487, 1.1817579, 1.0880683…
## $ Actual_HAP_i <dbl> -0.1887950, -0.2904738, -0.6210590, 0.7500…
## $ Actual_LAP_i <dbl> 1.2271677, -0.7745967, 1.4491377, 0.000000…
#41% of the sample is in a relationship
Compact_CompositeSurvey %>%
count(CurrentRel)
## # A tibble: 2 x 2
## CurrentRel n
## <fct> <int>
## 1 Partnered 44
## 2 <NA> 107
#What's the distribution of ethnicity?
Compact_CompositeSurvey %>%
count(Race)
## # A tibble: 7 x 2
## Race n
## <fct> <int>
## 1 Asian / Asian American 28
## 2 Black / African American 17
## 3 Hispanic / Latino/a 11
## 4 Native American / American Indian 3
## 5 Other 5
## 6 White / European American 64
## 7 <NA> 23
#Comment out the following to get interactive data table
# Compact_CompositeSurvey %>%
# DT::datatable()
skimr::skim(Compact_CompositeSurvey)
## Skim summary statistics
## n obs: 151
## n variables: 28
##
## ── Variable type:character ────────────────────
## variable missing complete n min max empty n_unique
## IdealRelDescription 7 144 151 11 976 0 144
##
## ── Variable type:factor ───────────────────────
## variable missing complete n n_unique
## CurrentRel 107 44 151 1
## Gender 1 150 151 2
## Race 23 128 151 6
## top_counts ordered
## NA: 107, Par: 44, Sin: 0 FALSE
## Fem: 89, Mal: 61, NA: 1 FALSE
## Whi: 64, Asi: 28, NA: 23, Bla: 17 FALSE
##
## ── Variable type:logical ──────────────────────
## variable missing complete n mean count
## GenderOther 151 0 151 NaN 151
##
## ── Variable type:numeric ──────────────────────
## variable missing complete n mean sd p0 p25 p50
## Actual_HAP 0 151 151 3.18 0.75 1.5 2.5 3
## Actual_HAP_i 2 149 151 0.35 0.63 -1.04 -0.11 0.47
## Actual_LAP 0 151 151 3.05 0.8 1 2.5 3
## Actual_LAP_i 2 149 151 0.26 0.73 -1.26 -0.33 0.3
## ActualRel_Calm 109 42 151 71.05 24.45 6 52.25 74
## ActualRel_Excited 109 42 151 69.62 26.67 2 55 75
## ActualRel_HAP 108 43 151 5.49 1.3 2 5 6
## ActualRel_Happy 109 42 151 84.12 16.25 41 77.5 86.5
## ActualRel_LAP 108 43 151 6.16 1.17 2 6 7
## Age 0 151 151 19.27 1.3 17 18 19
## Ideal_HAP 0 151 151 3.86 0.72 1 3.5 4
## Ideal_HAP_i 2 149 151 0.67 0.35 -0.77 0.55 0.74
## Ideal_LAP 0 151 151 4.01 0.72 2 3.5 4
## Ideal_LAP_i 2 149 151 0.77 0.36 -0.67 0.61 0.79
## IdealRel_Calm 0 151 151 71.82 19.55 11 58 75
## IdealRel_Companionate 3 148 151 6.61 0.68 4 6 7
## IdealRel_Excited 0 151 151 78.81 18.13 20 69 80
## IdealRel_Happy 0 151 151 92.17 11.7 51 86 100
## IdealRel_Passionate 0 151 151 5.82 1.13 2 5 6
## IOS 108 43 151 4.47 1.42 1 4 4
## mean_RAS 108 43 151 4.16 0.72 2.57 3.86 4.14
## NumPrevRel 1 150 151 1.78 1.7 0 1 1
## RelDuration 108 43 151 10.52 9.41 0 3 9
## p75 p100 hist
## 4 5 ▁▅▆▇▇▇▂▁
## 0.85 1.41 ▂▃▃▅▅▇▇▂
## 3.5 4.5 ▁▁▆▆▇▇▇▁
## 0.85 1.66 ▃▃▅▅▅▇▅▂
## 90 100 ▁▂▁▅▂▃▃▇
## 89.75 100 ▂▁▁▃▃▅▅▇
## 6 7 ▁▁▁▃▆▁▇▆
## 100 100 ▁▁▂▁▂▅▅▇
## 7 7 ▁▁▁▁▂▁▅▇
## 20 25 ▇▇▅▃▁▁▁▁
## 4 5 ▁▁▁▃▃▇▂▂
## 0.87 1.41 ▁▁▁▁▃▇▅▁
## 4.5 5 ▁▁▃▃▁▇▃▅
## 0.99 1.62 ▁▁▁▃▅▇▂▁
## 87 100 ▁▁▂▅▃▇▅▇
## 7 7 ▁▁▁▁▁▂▁▇
## 95.5 100 ▁▁▂▂▃▆▅▇
## 100 100 ▁▁▁▁▁▁▁▇
## 7 7 ▁▁▁▂▅▁▇▇
## 5 7 ▁▂▂▇▁▆▂▂
## 4.79 5 ▂▂▁▁▅▂▂▇
## 2 8 ▇▃▂▁▁▁▁▁
## 15.5 40 ▇▇▃▃▂▁▁▁
Visualize distribution of demographics:
#Race
Compact_CompositeSurvey %>%
ggplot(aes(x = Race)) +
geom_bar() +
coord_flip()
#Gender
Compact_CompositeSurvey %>%
ggplot(aes(x = Gender)) +
geom_bar()
#Age
Compact_CompositeSurvey %>%
ggplot(aes(x = Age)) +
geom_histogram(bins = 15)
#Number of previous relationships
Compact_CompositeSurvey %>%
ggplot(aes(x = NumPrevRel)) +
geom_histogram(bins = 20)
## Warning: Removed 1 rows containing non-finite values (stat_bin).
#Relationship status
Compact_CompositeSurvey %>%
ggplot(aes(x = CurrentRel)) +
geom_bar()
#Duration of current relationship
ggplot(data=subset(Compact_CompositeSurvey, !is.na(RelDuration)),
aes(x = RelDuration)) +
geom_histogram()+
xlab("Relationship Duration (in months)")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Visualize distribution of main variables:
#Ideal LAP Relationship: "My ideal relationship is caring, comfortable, and trusting."
Compact_CompositeSurvey %>%
ggplot(aes(x = IdealRel_Companionate)) +
geom_histogram(bins = 30)
## Warning: Removed 3 rows containing non-finite values (stat_bin).
#Ideal Relationship Calm: "To what extent do you want to feel calm in a romantic relationship?"
Compact_CompositeSurvey %>%
ggplot(aes(x = IdealRel_Calm)) +
geom_histogram(bins = 50)
#Ideal LAP Relationship: "My ideal relationship is passionate, intense, and exciting."
Compact_CompositeSurvey %>%
ggplot(aes(x = IdealRel_Passionate)) +
geom_histogram(bins = 30)
#Ideal Relationship Excited: "To what extent do you want to feel excited in a romantic relationship?"
Compact_CompositeSurvey %>%
ggplot(aes(x = IdealRel_Excited)) +
geom_histogram(bins = 50)
Visualize variables for partnered participants
#Actual LAP Relationship: "My current relationship is caring, comfortable, and trusting."
ggplot(data=subset(Compact_CompositeSurvey, !is.na(ActualRel_LAP)),
aes(x = ActualRel_LAP)) +
geom_histogram(bins = 30)
#Actual Relationship Calm: "To what extent do you actually feel calm in a romantic relationship?"
ggplot(data=subset(Compact_CompositeSurvey, !is.na(ActualRel_Calm)),
aes(x = ActualRel_Calm)) +
geom_histogram(bins = 50)
#Actual LAP Relationship: "My current relationship is passionate, intense, and exciting. "
ggplot(data=subset(Compact_CompositeSurvey, !is.na(ActualRel_HAP)),
aes(x = ActualRel_HAP)) +
geom_histogram(bins = 30)
#Actual Relationship Excited: "To what extent do you actually feel excited in a romantic relationship?"
ggplot(data=subset(Compact_CompositeSurvey, !is.na(ActualRel_Excited)),
aes(x = ActualRel_Excited)) +
geom_histogram(bins = 50)
#IOS (Inclusion of Partner in the Self)
ggplot(data=subset(Compact_CompositeSurvey, !is.na(IOS)),
aes(x = IOS)) +
geom_histogram(bins = 50)
#RAS (Relationship Satisfaction)
ggplot(data=subset(Compact_CompositeSurvey, !is.na(mean_RAS)),
aes(x = mean_RAS)) +
geom_histogram(bins = 50)
Visualize ideal affect variables
#Ideal HAP
Compact_CompositeSurvey %>%
ggplot(aes(x = Ideal_HAP)) +
geom_histogram(bins = 30)
#Ideal LAP
Compact_CompositeSurvey %>%
ggplot(aes(x = Ideal_LAP)) +
geom_histogram(bins = 30)
#Ideal HAP ipsatized
Compact_CompositeSurvey %>%
ggplot(aes(x = Ideal_HAP_i)) +
geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 2 rows containing non-finite values (stat_bin).
#Ideal LAP ipsatized
Compact_CompositeSurvey %>%
ggplot(aes(x = Ideal_LAP_i)) +
geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 2 rows containing non-finite values (stat_bin).
Main Analyses
RECAP: In a previous dataset, we had observed that ideal affect does not predict preferred the type of love style that is most closely associated with it (i.e., ideal HAP –> Eros, ideal LAP –> Storge). Therefore, in this analysis, we are interested in seeing where this link breaks down in the chain of: IDEAL AFFECT –> IDEAL RELATIONSHIP AFFECT –> IDEAL RELATIONSHIP TYPE
- Ideal affect: “Over the course of a typical week, I would ideally like to feel… [excited, enthusiastic; calm, relaxed]”
- Ideal relationship affect: “To what extent do you ideally want to feel [excited; calm] in a romantic relationship?”
- Ideal relationship type: Passionate vs. Companionate “My ideal relationship is passionate, intense, and exciting.”; “My ideal relationship is caring, comfortable, and trusting.”
So in this analysis, we will go sequentially to see whether 1 predicts 2, whether 2 predicts 3, and whether 1 predicts 3.
Across the whole sample, does ideal HAP/LAP predict wanting to feel HAP and LAP respectively in a relationship (ideal relationship affect)?
linearMod = lm(Compact_CompositeSurvey$IdealRel_Excited ~ Compact_CompositeSurvey$Ideal_HAP)
summary(linearMod)
##
## Call:
## lm(formula = Compact_CompositeSurvey$IdealRel_Excited ~ Compact_CompositeSurvey$Ideal_HAP)
##
## Residuals:
## Min 1Q Median 3Q Max
## -47.846 -8.295 1.395 10.515 32.875
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 27.644 6.943 3.981 0.000107 ***
## Compact_CompositeSurvey$Ideal_HAP 13.240 1.767 7.493 5.52e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 15.5 on 149 degrees of freedom
## Multiple R-squared: 0.2737, Adjusted R-squared: 0.2688
## F-statistic: 56.15 on 1 and 149 DF, p-value: 5.519e-12
linearMod = lm(Compact_CompositeSurvey$IdealRel_Calm ~ Compact_CompositeSurvey$Ideal_LAP)
summary(linearMod)
##
## Call:
## lm(formula = Compact_CompositeSurvey$IdealRel_Calm ~ Compact_CompositeSurvey$Ideal_LAP)
##
## Residuals:
## Min 1Q Median 3Q Max
## -51.23 -13.14 0.71 12.89 37.77
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 33.631 8.435 3.987 0.000104 ***
## Compact_CompositeSurvey$Ideal_LAP 9.532 2.072 4.600 8.95e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 18.36 on 149 degrees of freedom
## Multiple R-squared: 0.1244, Adjusted R-squared: 0.1185
## F-statistic: 21.16 on 1 and 149 DF, p-value: 8.953e-06
Ideal affect predicts wanting HAP/LAP (or Excited/Calm) in a relationship. This relationship is interestingly stronger for HAP compared to LAP.
Visualize above results:
ggplot(Compact_CompositeSurvey, aes(x = Ideal_HAP, y = IdealRel_Excited)) +
geom_point() +
geom_jitter(width = 0.5, height = 0) + #Only jitter the x axis because y axis is continuous
geom_smooth(method = lm) +
xlab("Ideal HAP") +
ylab("Ideal Relationship Excited") +
xlim(0.5, 5.5) +
ylim(0, 100)
ggplot(Compact_CompositeSurvey, aes(x = Ideal_LAP, y = IdealRel_Calm)) +
geom_point() +
geom_jitter(width = 0.5, height = 0) + #Only jitter the x axis because y axis is continuous
geom_smooth(method = lm) +
xlab("Ideal LAP") +
ylab("Ideal Relationship Calm") +
xlim(0.7, 5.5) +
ylim(0, 100)
Next, across the whole sample, does ideal relationship affect (Excited vs. Calm) predict ideal relationship type (passionate vs. companionate)?
linearMod = lm(Compact_CompositeSurvey$IdealRel_Passionate ~ Compact_CompositeSurvey$IdealRel_Excited)
summary(linearMod)
##
## Call:
## lm(formula = Compact_CompositeSurvey$IdealRel_Passionate ~ Compact_CompositeSurvey$IdealRel_Excited)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.8616 -0.5394 0.1384 0.5112 2.1552
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 3.150191 0.344748 9.138
## Compact_CompositeSurvey$IdealRel_Excited 0.033893 0.004264 7.949
## Pr(>|t|)
## (Intercept) 4.33e-16 ***
## Compact_CompositeSurvey$IdealRel_Excited 4.30e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9467 on 149 degrees of freedom
## Multiple R-squared: 0.2978, Adjusted R-squared: 0.2931
## F-statistic: 63.18 on 1 and 149 DF, p-value: 4.302e-13
linearMod = lm(Compact_CompositeSurvey$IdealRel_Companionate ~ Compact_CompositeSurvey$IdealRel_Calm)
summary(linearMod)
##
## Call:
## lm(formula = Compact_CompositeSurvey$IdealRel_Companionate ~
## Compact_CompositeSurvey$IdealRel_Calm)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.6669 -0.3260 0.2363 0.4068 0.9504
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.948211 0.208429 28.54 < 2e-16
## Compact_CompositeSurvey$IdealRel_Calm 0.009214 0.002783 3.31 0.00117
##
## (Intercept) ***
## Compact_CompositeSurvey$IdealRel_Calm **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6536 on 146 degrees of freedom
## (3 observations deleted due to missingness)
## Multiple R-squared: 0.06982, Adjusted R-squared: 0.06345
## F-statistic: 10.96 on 1 and 146 DF, p-value: 0.001174
Visualize above results:
ggplot(Compact_CompositeSurvey, aes(x = IdealRel_Excited, y = IdealRel_Passionate)) +
geom_point() +
geom_jitter(width = 0, height = 0.5) +
geom_smooth(method = lm) +
xlab("Ideal Relationship Excited") +
ylab("Ideal Passionate Relationship ") +
xlim(0,100) +
ylim(0.5,7.5)
ggplot(data=subset(Compact_CompositeSurvey, !is.na(IdealRel_Companionate)), aes(x = IdealRel_Calm, y = IdealRel_Companionate)) +
geom_point() +
geom_jitter(width = 0, height = 0.5) +
geom_smooth(method = lm) +
xlab("Ideal Relationship Calm") +
ylab("Ideal Companionate Relationship") +
xlim(0,100) +
ylim(0.5,7.5)
Based on these results, ideal relationship affect does indeed predict ideal relationship type. Interestingly, whereas there is similar variation in ideal relationship excited vs. calm, people tend to rate companionate love as high regardless, whereas passionate love follows ideal relationship affect more closely.
I think this suggests that a “caring, comfortable, and trusting” relationship is valued more unanimously, whereas a “passionate, intense, and exciting” relationship is only valued if one values HAP in a relationship.
Finally, across the whole sample, does ideal affect (HAP/LAP) predict ideal relationship type (passionate vs. companionate)?
linearMod = lm(Compact_CompositeSurvey$IdealRel_Passionate ~ Compact_CompositeSurvey$Ideal_HAP)
summary(linearMod)
##
## Call:
## lm(formula = Compact_CompositeSurvey$IdealRel_Passionate ~ Compact_CompositeSurvey$Ideal_HAP)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.16056 -0.61607 0.07503 0.83944 1.83944
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.8673 0.4422 6.485 1.23e-09 ***
## Compact_CompositeSurvey$Ideal_HAP 0.7644 0.1125 6.793 2.45e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9872 on 149 degrees of freedom
## Multiple R-squared: 0.2365, Adjusted R-squared: 0.2314
## F-statistic: 46.15 on 1 and 149 DF, p-value: 2.447e-10
linearMod = lm(Compact_CompositeSurvey$IdealRel_Companionate ~ Compact_CompositeSurvey$Ideal_LAP)
summary(linearMod)
##
## Call:
## lm(formula = Compact_CompositeSurvey$IdealRel_Companionate ~
## Compact_CompositeSurvey$Ideal_LAP)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4583 -0.3078 0.2408 0.3912 0.9931
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.40494 0.29870 18.095 < 2e-16 ***
## Compact_CompositeSurvey$Ideal_LAP 0.30096 0.07313 4.115 6.44e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6415 on 146 degrees of freedom
## (3 observations deleted due to missingness)
## Multiple R-squared: 0.1039, Adjusted R-squared: 0.0978
## F-statistic: 16.94 on 1 and 146 DF, p-value: 6.44e-05
Visualize above results:
ggplot(Compact_CompositeSurvey, aes(x = Ideal_HAP, y = IdealRel_Passionate)) +
geom_point() +
geom_jitter() +
geom_smooth(method = lm) +
xlab("Ideal HAP") +
ylab("Ideal Passionate Relationship") +
xlim(0.7,5.5) +
ylim(0.9,7.5)
ggplot(data=subset(Compact_CompositeSurvey, !is.na(IdealRel_Companionate)), aes(x = Ideal_LAP, y = IdealRel_Companionate)) +
geom_point() +
geom_jitter() +
geom_smooth(method = lm) +
xlab("Ideal LAP") +
ylab("Ideal Companionate Relationship") +
xlim(0.5,5.5) +
ylim(0.9,7.5)
It’s interesting that the above association (Ideal Affect <–> Ideal Relationship Type) emerges, because in Alice’s earlier dataset, there was no such relationship. However, it may have been due to the way she measured ideal relationship (Eros, Storge, etc.).
Q: Should I still measure “ideal relationship affect” in my FYP?
Cultural Comparisons
#Distribution of ethnicity
Compact_CompositeSurvey %>%
count(Race)
## # A tibble: 7 x 2
## Race n
## <fct> <int>
## 1 Asian / Asian American 28
## 2 Black / African American 17
## 3 Hispanic / Latino/a 11
## 4 Native American / American Indian 3
## 5 Other 5
## 6 White / European American 64
## 7 <NA> 23
We have N = 64 European Americans, but only N = 28 Asians/Asian Americans. This may not provide enough power, but I will attempt the analysis to explore what emerges
Do Asian Americans and European Americans differ in ideal HAP/LAP?
#Filter dataset for only Asian Americans/European Americans
Culture_CompositeSurvey <- Compact_CompositeSurvey %>%
filter(Race == "Asian / Asian American" | Race == "White / European American") %>%
rename(Culture = Race)
t.test(Culture_CompositeSurvey$Ideal_HAP_i ~ Culture_CompositeSurvey$Culture)
##
## Welch Two Sample t-test
##
## data: Culture_CompositeSurvey$Ideal_HAP_i by Culture_CompositeSurvey$Culture
## t = -0.67734, df = 49.421, p-value = 0.5013
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.2073086 0.1027711
## sample estimates:
## mean in group Asian / Asian American
## 0.6468715
## mean in group White / European American
## 0.6991403
t.test(Culture_CompositeSurvey$Ideal_LAP_i ~ Culture_CompositeSurvey$Culture)
##
## Welch Two Sample t-test
##
## data: Culture_CompositeSurvey$Ideal_LAP_i by Culture_CompositeSurvey$Culture
## t = 1.056, df = 63.733, p-value = 0.295
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.07146201 0.23169038
## sample estimates:
## mean in group Asian / Asian American
## 0.8164671
## mean in group White / European American
## 0.7363530
Asian Americans and European Americans do not differ in ideal HAP/LAP.
ggplot(Culture_CompositeSurvey, aes(x = Ideal_HAP, fill = Culture)) +
geom_density(alpha = 0.5) +
xlab("Ideal HAP") +
ylab("Frequency")
ggplot(Culture_CompositeSurvey, aes(x = Ideal_LAP, fill = Culture)) +
geom_density(alpha = 0.5) +
xlab("Ideal LAP") +
ylab("Frequency")
Do Asian Americans and European Americans differ in ideal relationship HAP/LAP?
t.test(Culture_CompositeSurvey$IdealRel_Excited ~ Culture_CompositeSurvey$Culture)
##
## Welch Two Sample t-test
##
## data: Culture_CompositeSurvey$IdealRel_Excited by Culture_CompositeSurvey$Culture
## t = -2.6494, df = 52.594, p-value = 0.01062
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -17.972081 -2.483276
## sample estimates:
## mean in group Asian / Asian American
## 72.17857
## mean in group White / European American
## 82.40625
t.test(Culture_CompositeSurvey$IdealRel_Calm ~ Culture_CompositeSurvey$Culture)
##
## Welch Two Sample t-test
##
## data: Culture_CompositeSurvey$IdealRel_Calm by Culture_CompositeSurvey$Culture
## t = 0.79181, df = 50.944, p-value = 0.4321
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -5.28168 12.16114
## sample estimates:
## mean in group Asian / Asian American
## 72.64286
## mean in group White / European American
## 69.20312
ggplot(Culture_CompositeSurvey, aes(x = IdealRel_Excited, fill = Culture)) +
geom_density(alpha = 0.5) +
xlab("Ideal Relationship Excited") +
ylab("Frequency")
ggplot(Culture_CompositeSurvey, aes(x = IdealRel_Calm, fill = Culture)) +
geom_density(alpha = 0.5) +
xlab("Ideal Relationship Calm") +
ylab("Frequency")
Even though we didn’t see any cultural differences in ideal affect, we do see a difference in ideal relationship affect such that European Americans value excitement in a relationship more than Asian Americans do. However, they did not differ in the extent to which they valued Calm in a relationship.
Do Asian Americans and European Americans differ in ideal relationship type?
t.test(Culture_CompositeSurvey$IdealRel_Passionate ~ Culture_CompositeSurvey$Culture)
##
## Welch Two Sample t-test
##
## data: Culture_CompositeSurvey$IdealRel_Passionate by Culture_CompositeSurvey$Culture
## t = -1.3265, df = 61.306, p-value = 0.1896
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.8003259 0.1619331
## sample estimates:
## mean in group Asian / Asian American
## 5.571429
## mean in group White / European American
## 5.890625
t.test(Culture_CompositeSurvey$IdealRel_Companionate ~ Culture_CompositeSurvey$Culture)
##
## Welch Two Sample t-test
##
## data: Culture_CompositeSurvey$IdealRel_Companionate by Culture_CompositeSurvey$Culture
## t = 0.28886, df = 50.22, p-value = 0.7739
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.2616518 0.3495639
## sample estimates:
## mean in group Asian / Asian American
## 6.615385
## mean in group White / European American
## 6.571429
ggplot(Culture_CompositeSurvey, aes(x = IdealRel_Passionate, fill = Culture)) +
geom_density(alpha = 0.5) +
xlab("Ideal Passionate Relationship") +
ylab("Frequency")
ggplot(data=subset(Culture_CompositeSurvey, !is.na(IdealRel_Companionate)), aes(x = IdealRel_Companionate, fill = Culture)) +
geom_density(alpha = 0.5) +
xlab("Ideal Passionate Relationship") +
ylab("Frequency")
There were no significant cultural differences in the extent to which Asian Americans and European Americans valued Passionate nor Companionate relationships. (However, the graph suggests that while both cultures follow identical distributions for ideal companionate love, European Americans are more saturated at the ceiling of the ideal passionate love item than Asian Americans.)
I would take these results with a grain of salt given that we’re only analyzing 28 Asians/Asian Americans against 64 European Americans.