Import the Datasets

Spring_2008 <- read_sav("~/Dropbox/Lab Projects/Love/AV and Love 2008_09/data/Love_Q day_Spring 2008_with love coded.sav")
Fall_2008 <- read_sav("~/Dropbox/Lab Projects/Love/AV and Love 2008_09/data/Love_Q day_Fall 2008.sav")
Winter_2009 <- read_sav("~/Dropbox/Lab Projects/Love/AV and Love 2008_09/data/Love_Q day_Winter 2009.sav")

SpringFall08Winter09 <- read_sav("~/Dropbox/Lab Projects/Love/AV and Love 2008_09/data/Love_Q day_SpringFall08Winter09.sav")

Eros Love vs. Storge Love:

There were 6 types of love participants were presented with:

  1. Eros: Eros Love is passionate and intense. This type of love views physical attraction as very important.

  2. Storge: Storge Love develops after a long period of friendship. This type of love is based on a history of caring.

  3. Pragma: Pragma Love makes sense. This type of love is based on having a similar background.

  4. Mania: Mania Love is uncertain. This type of love involves physical symptoms such as losing sleep from excitement or feeling sick when things aren’t right between partners.

  5. Agape: Agape love is selfless. This type of love involves putting someone else’s happiness before one’s own happiness.

Since I’m primarily interested in the difference between Eros Love and Storge Love (which seem to most closely reflect HAP and LAP, respectively), I will only be looking at these two for the rest of the analyses.

First, I looked at the distribution of rankings for Eros Love:

ggplot(data=SpringFall08Winter09, aes(ieros))+
  geom_bar()
## Warning: Removed 174 rows containing non-finite values (stat_count).

Note: 174 values are NA’s because the first quarter of data collection (Spring 2008) did not ask participants to rank the love types; rather, they just chose their ideal love type. I’ll look at this variable (which we have for the whole combined dataset) later.

I then looked at the distribution of rankings for Storge Love:

ggplot(data=SpringFall08Winter09, aes(istorge))+
  geom_bar()
## Warning: Removed 173 rows containing non-finite values (stat_count).

These plots tell me that Storge Love was most frequently ranked as #1, and less and less people ranked it lower. In contrast, Eros Love was most frequently ranked #2 or #3.

Based on these graphs, I wonder if there’s a significant difference between rankings of Eros vs. Storge Love, even before we consider any other variables:

t.test(SpringFall08Winter09$ieros, SpringFall08Winter09$istorge)
## 
##  Welch Two Sample t-test
## 
## data:  SpringFall08Winter09$ieros and SpringFall08Winter09$istorge
## t = 5.1365, df = 350.14, p-value = 4.657e-07
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.3863114 0.8657060
## sample estimates:
## mean of x mean of y 
##  2.681564  2.055556

Yes, there’s a statistically significant (p = 0000004657) difference: Participants tended to rank Storge Love higher (M = 2.06, SD = 1.24) than Eros Love (M = 2.68, SD = 1.07).

Still, we may see that culture and/or ideal affect are associated with different preferences for each love type. But first, I checked to see whether the two cultures (European Americans vs. Asian Americans) differed in the extent to which they reported wanting to feel high-arousal positive affect and low-arousal positive affect (“ideal HAP” and “ideal LAP”).

Do cultures differ in ideal affect?

In keeping with the recommendation to use ipsatized scores for cultural group comparisons, but use raw scores when conducting correlational analyses (because ipsatizing can significantly reduce variance), I’ll use ipsatized scores for the following analyses, since it is a cultural comparison:

Testing whether European Americans report higher ideal HAP than Asian Americans:

t.test(SpringFall08Winter09$`i$hap_i`~SpringFall08Winter09$culture)
## 
##  Welch Two Sample t-test
## 
## data:  SpringFall08Winter09$`i$hap_i` by SpringFall08Winter09$culture
## t = 0.27468, df = 90.39, p-value = 0.7842
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.09395312  0.12410326
## sample estimates:
## mean in group 0 mean in group 1 
##       0.8014646       0.7863895

No, there are no differences in ideal HAP between European Americans and Asian Americans.

Testing whether Asian Americans report higher ideal LAP than European Americans:

t.test(SpringFall08Winter09$`i$lap_i`~SpringFall08Winter09$culture)
## 
##  Welch Two Sample t-test
## 
## data:  SpringFall08Winter09$`i$lap_i` by SpringFall08Winter09$culture
## t = -1.129, df = 110.39, p-value = 0.2614
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.17201116  0.04715256
## sample estimates:
## mean in group 0 mean in group 1 
##       0.9108881       0.9733174

No, there are no differences in ideal LAP between European Americans and Asian Americans.

Part of this could be that we have N=154 for European Americans, but only N=54 for Asian Americans. And N=145 for “other” (stored as NA’s, because they were neither European American nor Asian American):

sum(SpringFall08Winter09$culture=="European American", na.rm = TRUE)
## [1] 0
sum(SpringFall08Winter09$culture=="Asian American", na.rm = TRUE)
## [1] 0
sum(is.na(SpringFall08Winter09$culture))
## [1] 145

Still, I think it would be worthwhile to look at whether culture (and later, ideal affect) predicts preferences for love styles - that will be the focus of the next section.

Does culture predict love style?

In order to see whether European Americans rank Eros Love higher than Asian Americans, I conducted a t-test (IV = culture, DV = ranking of Eros Love):

t.test(SpringFall08Winter09$ieros~SpringFall08Winter09$culture)
## 
##  Welch Two Sample t-test
## 
## data:  SpringFall08Winter09$ieros by SpringFall08Winter09$culture
## t = -2.0206, df = 41.202, p-value = 0.04985
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -1.0117073322 -0.0003408606
## sample estimates:
## mean in group 0 mean in group 1 
##        2.493976        3.000000

Yes, it looks like European Americans rank Eros Love higher (M = 2.49, SD = 1.02) than Asian Americans (M = 3.00, SD = 1.13), p = 0.05 (barely significant, though).

Here’s the bar graph with error bars:

SpringFall08Winter09$culture <- factor(SpringFall08Winter09$culture, levels=c(0,1), labels = c("European American","Asian American"))

# Create a group-means data set
GroupMeans <- SpringFall08Winter09 %>% 
        group_by(culture) %>% 
        summarise(Culture_Means = mean(ieros, na.rm=TRUE), Culture_SD = sd(ieros, na.rm=TRUE))


ggplot(GroupMeans, aes(x=culture, y=Culture_Means)) +
  geom_bar(stat="identity")+
  xlab("Culture")+
  ylab("Ranking of Eros Love")+
  geom_errorbar(aes(ymin=Culture_Means-Culture_SD, ymax=Culture_Means+Culture_SD), width=.2,
                 position=position_dodge(.9))

Note: Counterintuitively, the shorter the bar, the higher the ranking.

Similarly, let’s now see whether there is a cultural difference in rankings of Storge Love:

t.test(SpringFall08Winter09$istorge~SpringFall08Winter09$culture)
## 
##  Welch Two Sample t-test
## 
## data:  SpringFall08Winter09$istorge by SpringFall08Winter09$culture
## t = -0.58082, df = 40.057, p-value = 0.5646
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.7465861  0.4132528
## sample estimates:
## mean in group European American    mean in group Asian American 
##                        1.940476                        2.107143

No difference in ranking of ideal Storge between cultures, p = 0.56.

To visualize:

# Create a group-means data set
GroupMeans <- SpringFall08Winter09 %>% 
        group_by(culture) %>% 
        summarise(Culture_Means = mean(istorge, na.rm=TRUE), Culture_SD = sd(istorge, na.rm=TRUE))


ggplot(GroupMeans, aes(x=culture, y=Culture_Means)) +
  geom_bar(stat="identity")+
  xlab("Culture")+
  ylab("Ranking of Storge Love")+
  geom_errorbar(aes(ymin=Culture_Means-Culture_SD, ymax=Culture_Means+Culture_SD), width=.2,
                 position=position_dodge(.9))

Thus, it seems like cultures differ in their rankings of Eros (but not Storge) Love: European Americans rank Eros Love higher than Asian Americans.

There is another way to look at the same question: The variables “erosideal” and “erosstorge” indicate whether participants chose Eros or Storge (respectively) as their ideal love style (1) or not (0). While this binary outcome variable is a less informative version of the ordinal ranking variable used above, the advantage is that we have this across participants from all academic quarters (whereas the above ordinal scale was only measured 2/3 academic quarters). Perhaps the added power we get from additional participants may outweight the less informative nature of the scale.

I will use a logistic regression to test whether culture predicts choosing Eros Love as ideal:

mylogit <- glm(erosideal ~ culture, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = erosideal ~ culture, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.6106  -0.6106  -0.6106  -0.4452   2.1730  
## 
## Coefficients:
##                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)            -1.5851     0.2195  -7.220 5.18e-13 ***
## cultureAsian American  -0.6766     0.5186  -1.305    0.192    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 169.08  on 199  degrees of freedom
## Residual deviance: 167.18  on 198  degrees of freedom
##   (153 observations deleted due to missingness)
## AIC: 171.18
## 
## Number of Fisher Scoring iterations: 4

It does not seem like culture predicts choosing Eros Love as the ideal love style (p = 0.192).

To see if there is a cultural difference for choosing Storge Love as ideal:

mylogit <- glm(storgeideal ~ culture, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = storgeideal ~ culture, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.8628  -0.8628  -0.8628   1.5288   1.5477  
## 
## Coefficients:
##                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)            -0.7963     0.1776  -4.484 7.33e-06 ***
## cultureAsian American  -0.0420     0.3479  -0.121    0.904    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 248.38  on 200  degrees of freedom
## Residual deviance: 248.37  on 199  degrees of freedom
##   (152 observations deleted due to missingness)
## AIC: 252.37
## 
## Number of Fisher Scoring iterations: 4

Again, there is no association between culture and choosing Storge Love as the ideal love style (p = 0.90).

Overall though, I’m noticing that cultural differences are more likely to emerge for Eros Love than for Storge Love, which is interesting.

Conclusion: European Americans rank Eros Love higher than Asian Americans, but they do not differ in their rankings of Storge Love.

Even though I didn’t find cultural differences in ideal affect, I’m curious whether ideal affect would still predict preferences for Eros vs. Storge Love, because we have ideal affect scores for the whole sample whereas the culture variable excludes 70% of our sample (consisting of people who were neither European American nor Asian American).

Does ideal affect predict rankings of Eros and Storge Love?

First, I will see whether ideal HAP predicts rankings of ideal Eros:

mylogit <- glm(erosideal ~ `i$hap`, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = erosideal ~ `i$hap`, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.6338  -0.5782  -0.5605  -0.5267   2.0792  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)   
## (Intercept)  -2.5084     0.8717  -2.878  0.00401 **
## `i$hap`       0.2010     0.2239   0.898  0.36932   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 271.50  on 322  degrees of freedom
## Residual deviance: 270.69  on 321  degrees of freedom
##   (30 observations deleted due to missingness)
## AIC: 274.69
## 
## Number of Fisher Scoring iterations: 4

It seems ideal HAP does not predict indicating Eros Love as ideal (p = 0.37).

To see whether ideal LAP predicts indicating Storge Love as ideal:

mylogit <- glm(storgeideal ~ `i$lap`, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = storgeideal ~ `i$lap`, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.9691  -0.9129  -0.8376   1.4408   1.7406  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)  
## (Intercept)  -1.6216     0.7019  -2.310   0.0209 *
## `i$lap`       0.2219     0.1714   1.295   0.1954  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 407.39  on 322  degrees of freedom
## Residual deviance: 405.69  on 321  degrees of freedom
##   (30 observations deleted due to missingness)
## AIC: 409.69
## 
## Number of Fisher Scoring iterations: 4

Once again, ideal LAP does not significantly predict ranking of Storge Love.

Another way to look at this question is to use the ordinal DV of Eros and Storge ranking (but we’re missing data from the Spring 2008 quarter, because that survey only asked for their ideal love style rather than ranking).

So to see whether ideal HAP (non-ipsatized) predicts ranking of Eros Love, I did a linear regression:

linearMod <- lm(ieros ~ `i$hap`, data=SpringFall08Winter09)  # build linear regression model
summary(linearMod)
## 
## Call:
## lm(formula = ieros ~ `i$hap`, data = SpringFall08Winter09)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.8408 -0.6941  0.2081  0.4526  2.5993 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   2.1074     0.4458   4.727  4.9e-06 ***
## `i$hap`       0.1467     0.1162   1.263    0.209    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.06 on 163 degrees of freedom
##   (188 observations deleted due to missingness)
## Multiple R-squared:  0.009685,   Adjusted R-squared:  0.00361 
## F-statistic: 1.594 on 1 and 163 DF,  p-value: 0.2085

No, it looks like ideal HAP does not predict ranking of Eros Love. To visualize this:

ggplot(SpringFall08Winter09, aes(x=`i$hap`, y=ieros))+
  geom_point()+
  geom_smooth(method=lm)+
  xlab("Ideal HAP")+
  ylab("Ranking of Eros Love")+
  xlim(0,1.5)
## Warning: Removed 353 rows containing non-finite values (stat_smooth).
## Warning: Removed 353 rows containing missing values (geom_point).

Let’s do the same thing for LAP: does ideal LAP (ipsatized) predict rankings of Storge Love?

linearMod <- lm(istorge ~ `i$lap`, data=SpringFall08Winter09)  # build linear regression model
summary(linearMod)
## 
## Call:
## lm(formula = istorge ~ `i$lap`, data = SpringFall08Winter09)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.2597 -1.0646 -0.2597  0.9054  2.9204 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)   1.3595     0.5336   2.548   0.0118 *
## `i$lap`       0.1800     0.1337   1.347   0.1799  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.253 on 164 degrees of freedom
##   (187 observations deleted due to missingness)
## Multiple R-squared:  0.01094,    Adjusted R-squared:  0.00491 
## F-statistic: 1.814 on 1 and 164 DF,  p-value: 0.1799

No, it looks like ideal LAP does not predict ranking of Storge Love. To visualize this:

ggplot(SpringFall08Winter09, aes(x=`i$lap`, y=istorge))+
  geom_point()+
  geom_smooth(method=lm)+
  xlab("Ideal LAP")+
  ylab("Ranking of Storge Love")
## Warning: Removed 187 rows containing non-finite values (stat_smooth).
## Warning: Removed 187 rows containing missing values (geom_point).

From these results, it seems like ideal affect does not predict whether participants indicate Eros or Storge Love to be their ideal love style. Which is actually a huge surprise to me. I would’ve expected that the link between preferring high-arousal positive affect and (presumably) high-arousal love like Eros Love would have been pretty clear (and same for ideal LAP/Storge Love).

Note: I also reversed the pairs for each analysis (ideal HAP <–> IdealStorge and ideal LAP <–> IdealEros) but this didn’t yield any significant results.

Does ideal affect WITHIN culture predict preferred love style?

One thing I still want to explore is whether, within cultures, ideal affect predicts preferred love style.

First, here are the faceted plots for ideal HAP/Eros Love and ideal LAP/Storge Love, respectively:

labels <- c("0" = "European American", "1" = "Asian American")

HAPtoEros <-  ggplot(SpringFall08Winter09, aes(x=`i$hap`, y=ieros))+
  geom_point()+
  geom_smooth(method=lm)+
  xlab("Ideal HAP")+
  ylab("Ranking of Eros Love")

HAPtoEros + facet_grid(. ~ culture, labeller=labeller(culture = labels))
## Warning: Removed 188 rows containing non-finite values (stat_smooth).
## Warning: Removed 188 rows containing missing values (geom_point).

LAPtoStorge <-  ggplot(SpringFall08Winter09, aes(x=`i$lap`, y=istorge))+
  geom_point()+
  geom_smooth(method=lm)+
  xlab("Ideal LAP")+
  ylab("Ranking of Storge Love")

LAPtoStorge + facet_grid(. ~ culture, labeller=labeller(culture = labels))
## Warning: Removed 187 rows containing non-finite values (stat_smooth).
## Warning: Removed 187 rows containing missing values (geom_point).

Starting with European Americans, ideal HAP does not predict Eros Love ranking:

linearMod = lm(ieros ~ `i$hap`, data=subset(SpringFall08Winter09, culture=="European American"))
summary(linearMod)
## 
## Call:
## lm(formula = ieros ~ `i$hap`, data = subset(SpringFall08Winter09, 
##     culture == "European American"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.6019 -0.4853 -0.3299  0.5924  2.3592 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   2.8739     0.6738   4.265 6.23e-05 ***
## `i$hap`      -0.1166     0.1769  -0.659    0.512    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9857 on 69 degrees of freedom
##   (83 observations deleted due to missingness)
## Multiple R-squared:  0.006255,   Adjusted R-squared:  -0.008147 
## F-statistic: 0.4343 on 1 and 69 DF,  p-value: 0.5121

European American ideal LAP does not predict Storge Love ranking:

linearMod = lm(istorge ~ `i$lap`, data=subset(SpringFall08Winter09, culture=="European American"))
summary(linearMod)
## 
## Call:
## lm(formula = istorge ~ `i$lap`, data = subset(SpringFall08Winter09, 
##     culture == "European American"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.0651 -0.9394 -0.3975  0.3840  3.0187 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)   1.4364     0.7243   1.983   0.0513 .
## `i$lap`       0.1258     0.1862   0.675   0.5017  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.164 on 70 degrees of freedom
##   (82 observations deleted due to missingness)
## Multiple R-squared:  0.006474,   Adjusted R-squared:  -0.007719 
## F-statistic: 0.4562 on 1 and 70 DF,  p-value: 0.5017

However, within Asian Americans, ideal HAP basically does (p 0= 0.0554) predict Eros Love ranking:

linearMod = lm(ieros ~ `i$hap`, data=subset(SpringFall08Winter09, culture=="Asian American"))
summary(linearMod)
## 
## Call:
## lm(formula = ieros ~ `i$hap`, data = subset(SpringFall08Winter09, 
##     culture == "Asian American"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.5896 -0.7729 -0.3228  0.7271  2.0438 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)   0.7567     1.1193   0.676   0.5053  
## `i$hap`       0.5499     0.2737   2.009   0.0554 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.128 on 25 degrees of freedom
##   (27 observations deleted due to missingness)
## Multiple R-squared:  0.139,  Adjusted R-squared:  0.1046 
## F-statistic: 4.037 on 1 and 25 DF,  p-value: 0.05542
ggplot(subset(SpringFall08Winter09, culture=="Asian American"), aes(x=`i$hap`, y=ieros))+
  geom_point()+
  geom_smooth(method=lm)+
  xlab("Ideal HAP in AA")+
  ylab("Ranking of Eros Love in AA")+
  xlim(1,5)
## Warning: Removed 27 rows containing non-finite values (stat_smooth).
## Warning: Removed 27 rows containing missing values (geom_point).

Asian American ideal LAP does not predict Storge Love ranking:

linearMod = lm(istorge ~ `i$lap`, data=subset(SpringFall08Winter09, culture=="Asian American"))
summary(linearMod)
## 
## Call:
## lm(formula = istorge ~ `i$lap`, data = subset(SpringFall08Winter09, 
##     culture == "Asian American"))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.3315 -1.1361 -0.2664  0.9291  2.7988 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)
## (Intercept)   1.3543     1.7612   0.769    0.449
## `i$lap`       0.1955     0.4285   0.456    0.652
## 
## Residual standard error: 1.4 on 25 degrees of freedom
##   (27 observations deleted due to missingness)
## Multiple R-squared:  0.008254,   Adjusted R-squared:  -0.03142 
## F-statistic: 0.2081 on 1 and 25 DF,  p-value: 0.6522

To summarize, it seems that within Asian Americans, ideal HAP predicts ranking of Eros Love. However, there weren’t any other ideal affect <–> love style associations found. It’s possible we’re lacking power to detect this effect here.

Note: I also reversed the pairs for each analysis (ideal HAP <–> IdealStorge and ideal LAP <–> IdealEros) but this didn’t yield any significant results.

Switching gears a little bit, I want to see how ideal love style is related to current and past romantic relationships. That is the focus of the next section.

Relationship descriptives:

First, descriptives on current relationships status and duration; current love type; and number of previous relationships.

SpringFall08Winter09$currentrel <- factor(SpringFall08Winter09$currentrel,
levels = c(0,1),
labels = c("Single", "Partnered"))

ggplot(data=SpringFall08Winter09, aes(currentrel))+
  geom_bar()+
  xlab("Relationship Status")+
  ylab("Frequency")

More single than partnered participants.

ggplot(data=SpringFall08Winter09, aes(currenttime))+
  geom_histogram()+
  xlab("Relationship Duration (Months)")+
  ylab("Frequency")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 214 rows containing non-finite values (stat_bin).

Most relationships are shorter than 6 months.

ggplot(data=SpringFall08Winter09, aes(lasttime))+
  geom_histogram()+
  xlab("Past Relationship Duration (Months)")+
  ylab("Frequency")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 102 rows containing non-finite values (stat_bin).

Striking to note that most previous relationships are under 5 months long(!).

Curious whether relationship duration (past and current) differ by culture:

t.test(SpringFall08Winter09$currenttime~SpringFall08Winter09$culture)
## 
##  Welch Two Sample t-test
## 
## data:  SpringFall08Winter09$currenttime by SpringFall08Winter09$culture
## t = 0.45351, df = 41.026, p-value = 0.6526
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -6.000177  9.475466
## sample estimates:
## mean in group European American    mean in group Asian American 
##                        16.70238                        14.96474
t.test(SpringFall08Winter09$lasttime~SpringFall08Winter09$culture)
## 
##  Welch Two Sample t-test
## 
## data:  SpringFall08Winter09$lasttime by SpringFall08Winter09$culture
## t = 1.0247, df = 99.123, p-value = 0.308
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -1.256114  3.938852
## sample estimates:
## mean in group European American    mean in group Asian American 
##                        8.927083                        7.585714

Surprisingly, there don’t seem to be any cultural differences in relationship duration (past or current)!

SpringFall08Winter09$currentlove <- factor(SpringFall08Winter09$currentlove,
levels = c(1,2,3,4,5),
labels = c("Eros", "Storge", "Pragma", "Mania", "Agape"))

ggplot(data=SpringFall08Winter09, aes(currentlove))+
  geom_bar()+
  xlab("Current Love Type")+
  ylab("Frequency")

Storge Love is the most common type among those currently in a relationship, followed by Eros/Agape.

ggplot(data=SpringFall08Winter09, aes(previousrel))+
  geom_histogram()+
  xlab("Number of Previous Relationships")+
  ylab("Frequency")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 7 rows containing non-finite values (stat_bin).

Surprisingly high number of people reporting no/low number of past relationships (median = 2).

Do people enter into relationship types that they want?

In other words, does ideal love type predict the kind of love type participants have in their current or past relationship?

First, ranking Eros Love high does predict current Eros relationship:

mylogit <- glm(currenteros ~ ieros, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = currenteros ~ ieros, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.3974  -0.9195  -0.5562  -0.1831   1.9712  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)   
## (Intercept)   1.6497     0.9527   1.732  0.08334 . 
## ieros        -1.1459     0.4006  -2.860  0.00423 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 68.609  on 61  degrees of freedom
## Residual deviance: 57.858  on 60  degrees of freedom
##   (291 observations deleted due to missingness)
## AIC: 61.858
## 
## Number of Fisher Scoring iterations: 5
ggplot(data=SpringFall08Winter09, aes(x=ieros, y=currenteros, na.rm=TRUE)) + geom_point() + 
  stat_smooth(method="glm", method.args=list(family="binomial")) +
  xlab("Ideal Eros") +
  ylab("Current Eros Relationship")
## Warning: Removed 291 rows containing non-finite values (stat_smooth).
## Warning: Removed 291 rows containing missing values (geom_point).

Second, ranking Storge Love high only marginally predicts current Storge relationship:

mylogit <- glm(currentstorge ~ istorge, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = currentstorge ~ istorge, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.3005  -1.1421  -0.8543   1.0591   1.7055  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)  
## (Intercept)   0.6531     0.5200   1.256   0.2092  
## istorge      -0.3683     0.2171  -1.696   0.0899 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 85.692  on 61  degrees of freedom
## Residual deviance: 82.584  on 60  degrees of freedom
##   (291 observations deleted due to missingness)
## AIC: 86.584
## 
## Number of Fisher Scoring iterations: 4
ggplot(data=SpringFall08Winter09, aes(x=istorge, y=currentstorge, na.rm=TRUE)) + geom_point() + 
  stat_smooth(method="glm", method.args=list(family="binomial")) +
  xlab("Ideal Storge") +
  ylab("Current Storge Relationship")
## Warning: Removed 291 rows containing non-finite values (stat_smooth).
## Warning: Removed 291 rows containing missing values (geom_point).

Now, looking at whether ideal love type predicts the last relationship’s love type:

Interestingly, ideal Eros is not associated with the last relationship being Eros:

mylogit <- glm(lasteros ~ ieros, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = lasteros ~ ieros, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.9263  -0.9213  -0.9164   1.4572   1.4750  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.61089    0.51056  -1.197    0.231
## ieros       -0.01322    0.18733  -0.071    0.944
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 157.09  on 121  degrees of freedom
## Residual deviance: 157.09  on 120  degrees of freedom
##   (231 observations deleted due to missingness)
## AIC: 161.09
## 
## Number of Fisher Scoring iterations: 4

Similarly, ideal Storge is not associated with the last relationship being Storge!

mylogit <- glm(laststorge ~ istorge, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = laststorge ~ istorge, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.7441  -0.7441  -0.7256  -0.6721   1.7882  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)  
## (Intercept) -1.08515    0.43090  -2.518   0.0118 *
## istorge     -0.05756    0.17255  -0.334   0.7387  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 131.44  on 121  degrees of freedom
## Residual deviance: 131.33  on 120  degrees of freedom
##   (231 observations deleted due to missingness)
## AIC: 135.33
## 
## Number of Fisher Scoring iterations: 4

The above findings suggest that the type of love you currently rank highly is predictive of the type of love characterizing your current relationship, but not your last relationship. Which makes me curious about whether current and past love types are related:

SpringFall08Winter09$lastlove <- factor(SpringFall08Winter09$lastlove,
levels = c(1,2,3,4,5),
labels = c("Eros", "Storge", "Pragma", "Mania", "Agape"))

sum(SpringFall08Winter09$currentlove == SpringFall08Winter09$lastlove, na.rm=TRUE)
## [1] 14

The above suggests that we only have 14 participants out of 99 (14%) that reported having the SAME love type currently as the one they had in their previous relationship(!). I would have expected a higher proportion, but this suggests people are much more malleable in the types of relationships they have/had than I expected.

Taken together, it looks like people do not stick to a single love style, at least in terms of the relationships they end up in (we don’t have data to judge steady preferred love types are). So it would make sense that while the current ideal love type predicts the current relationship they’re in, this same preference would not predict the love type they had in the previous relationship (they might have had different ideal love types in the past).

Looking at associations between ideal love style and relationship characteristics:

Neither ideal Eros or ideal Storge predict current relationship duration:

linearMod = lm(SpringFall08Winter09$currenttime ~ SpringFall08Winter09$ieros)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$currenttime ~ SpringFall08Winter09$ieros)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -14.891  -8.453  -4.719   8.359  36.050 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)  
## (Intercept)                   8.259      4.192   1.970   0.0532 .
## SpringFall08Winter09$ieros    1.846      1.481   1.246   0.2172  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11.94 on 64 degrees of freedom
##   (287 observations deleted due to missingness)
## Multiple R-squared:  0.02369,    Adjusted R-squared:  0.008439 
## F-statistic: 1.553 on 1 and 64 DF,  p-value: 0.2172
linearMod = lm(SpringFall08Winter09$currenttime ~ SpringFall08Winter09$istorge)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$currenttime ~ SpringFall08Winter09$istorge)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -13.803  -8.845  -3.803  10.197  34.826 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                   14.1172     2.9188   4.837 8.66e-06 ***
## SpringFall08Winter09$istorge  -0.3145     1.1682  -0.269    0.789    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 12.06 on 64 degrees of freedom
##   (287 observations deleted due to missingness)
## Multiple R-squared:  0.001131,   Adjusted R-squared:  -0.01448 
## F-statistic: 0.07246 on 1 and 64 DF,  p-value: 0.7887

Similarly, neither ideal Eros nor ideal Storge predict previous relationship duration:

linearMod = lm(SpringFall08Winter09$lasttime ~ SpringFall08Winter09$ieros)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$lasttime ~ SpringFall08Winter09$ieros)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -8.523 -6.472 -4.472  3.076 51.227 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                  9.3750     2.5575   3.666 0.000372 ***
## SpringFall08Winter09$ieros  -0.3009     0.9193  -0.327 0.744021    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 10.44 on 117 degrees of freedom
##   (234 observations deleted due to missingness)
## Multiple R-squared:  0.0009148,  Adjusted R-squared:  -0.007624 
## F-statistic: 0.1071 on 1 and 117 DF,  p-value: 0.744
linearMod = lm(SpringFall08Winter09$lasttime ~ SpringFall08Winter09$istorge)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$lasttime ~ SpringFall08Winter09$istorge)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -8.504 -6.470 -4.470  2.746 51.530 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                    9.0378     1.9370   4.666 8.24e-06 ***
## SpringFall08Winter09$istorge  -0.2837     0.7522  -0.377    0.707    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 10.37 on 117 degrees of freedom
##   (234 observations deleted due to missingness)
## Multiple R-squared:  0.001214,   Adjusted R-squared:  -0.007322 
## F-statistic: 0.1422 on 1 and 117 DF,  p-value: 0.7067

However, both ideal Eros and ideal Storge predict number of previous partners:

linearMod = lm(SpringFall08Winter09$previousrel ~ SpringFall08Winter09$ieros)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$previousrel ~ SpringFall08Winter09$ieros)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.1090 -1.2678 -0.2678  0.4518  8.8910 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                  2.3894     0.3493   6.840 1.26e-10 ***
## SpringFall08Winter09$ieros  -0.2804     0.1208  -2.322   0.0214 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.708 on 176 degrees of freedom
##   (175 observations deleted due to missingness)
## Multiple R-squared:  0.02971,    Adjusted R-squared:  0.0242 
## F-statistic:  5.39 on 1 and 176 DF,  p-value: 0.0214
ggplot(SpringFall08Winter09, aes(x=ieros, y=previousrel))+
  geom_point()+
  geom_smooth(method=lm)+
  xlab("Ranking of Eros Love")+
  ylab("Number of past partners")
## Warning: Removed 175 rows containing non-finite values (stat_smooth).
## Warning: Removed 175 rows containing missing values (geom_point).

linearMod = lm(SpringFall08Winter09$previousrel ~ SpringFall08Winter09$istorge)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$previousrel ~ SpringFall08Winter09$istorge)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.7772 -1.2309 -0.2309  0.7691  9.3825 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                    0.8443     0.2445   3.453 0.000695 ***
## SpringFall08Winter09$istorge   0.3866     0.1027   3.763 0.000229 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.668 on 176 degrees of freedom
##   (175 observations deleted due to missingness)
## Multiple R-squared:  0.07445,    Adjusted R-squared:  0.06919 
## F-statistic: 14.16 on 1 and 176 DF,  p-value: 0.0002289
ggplot(SpringFall08Winter09, aes(x=istorge, y=previousrel))+
  geom_point()+
  geom_smooth(method=lm)+
  xlab("Ranking of Storge Love")+
  ylab("Number of past partners")
## Warning: Removed 175 rows containing non-finite values (stat_smooth).
## Warning: Removed 175 rows containing missing values (geom_point).

Both effects were in the expected directions: The higher you rank Eros Love, the more partners you’ve had in the past. The higher you rank Storge Love, the less partners you’ve had in the past.

Does ideal affect predict past and current relationship duration?

Next 4 analyses: Ideal HAP doesn’t predict duration of current or past relationship, but ideal LAP marginally predicts duration of current (but not past) relationship.

linearMod = lm(SpringFall08Winter09$currenttime ~ SpringFall08Winter09$`i$hap`)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$currenttime ~ SpringFall08Winter09$`i$hap`)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -16.728 -10.483  -4.597   8.015  87.351 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)
## (Intercept)                    11.530      7.508   1.536    0.127
## SpringFall08Winter09$`i$hap`    1.114      1.957   0.569    0.570
## 
## Residual standard error: 15.53 on 128 degrees of freedom
##   (223 observations deleted due to missingness)
## Multiple R-squared:  0.002525,   Adjusted R-squared:  -0.005268 
## F-statistic: 0.324 on 1 and 128 DF,  p-value: 0.5702
linearMod = lm(SpringFall08Winter09$currenttime ~ SpringFall08Winter09$`i$lap`)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$currenttime ~ SpringFall08Winter09$`i$lap`)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -18.250 -10.521  -5.184   7.944  84.239 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)  
## (Intercept)                     3.503      7.433   0.471   0.6382  
## SpringFall08Winter09$`i$lap`    3.099      1.852   1.673   0.0967 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 15.38 on 128 degrees of freedom
##   (223 observations deleted due to missingness)
## Multiple R-squared:  0.0214, Adjusted R-squared:  0.01376 
## F-statistic:   2.8 on 1 and 128 DF,  p-value: 0.09673
ggplot(SpringFall08Winter09, aes(x=`i$lap`, y=currenttime))+
  geom_point()+
  geom_smooth(method=lm)+
  xlab("Ideal LAP")+
  ylab("Duration of current relationship")
## Warning: Removed 223 rows containing non-finite values (stat_smooth).
## Warning: Removed 223 rows containing missing values (geom_point).

linearMod = lm(SpringFall08Winter09$lasttime ~ SpringFall08Winter09$`i$hap`)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$lasttime ~ SpringFall08Winter09$`i$hap`)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -11.067  -7.239  -4.717   2.806  49.500 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                    14.940      3.957   3.775 0.000202 ***
## SpringFall08Winter09$`i$hap`   -1.306      1.033  -1.264 0.207633    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11.14 on 237 degrees of freedom
##   (114 observations deleted due to missingness)
## Multiple R-squared:  0.006691,   Adjusted R-squared:  0.0025 
## F-statistic: 1.597 on 1 and 237 DF,  p-value: 0.2076
linearMod = lm(SpringFall08Winter09$lasttime ~ SpringFall08Winter09$`i$lap`)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$lasttime ~ SpringFall08Winter09$`i$lap`)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -9.814 -7.086 -4.100  2.074 50.114 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)  
## (Intercept)                   10.5536     4.0786   2.588   0.0103 *
## SpringFall08Winter09$`i$lap`  -0.1335     1.0101  -0.132   0.8950  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11.17 on 237 degrees of freedom
##   (114 observations deleted due to missingness)
## Multiple R-squared:  7.372e-05,  Adjusted R-squared:  -0.004145 
## F-statistic: 0.01747 on 1 and 237 DF,  p-value: 0.895

In sum, ideal affect doesn’t seem very linked to duration of current or past (except for ideal LAP marginally predicting current relationship duration, such that higher ideal LAP was associated with longer relationship duration). Surprising that we don’t find this same effect for past relationships as well. Perhaps ideal LAP fluctuates over time?

Does ideal affect predict the number of past partners?

Neither ideal HAP nor ideal LAP predict number of previous partners:

linearMod = lm(SpringFall08Winter09$previousrel ~ SpringFall08Winter09$`i$hap`)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$previousrel ~ SpringFall08Winter09$`i$hap`)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.1222 -1.0116 -0.0116  0.9884 18.0437 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                   2.28801    0.61789   3.703 0.000251 ***
## SpringFall08Winter09$`i$hap` -0.09213    0.16149  -0.571 0.568727    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.052 on 323 degrees of freedom
##   (28 observations deleted due to missingness)
## Multiple R-squared:  0.001007,   Adjusted R-squared:  -0.002086 
## F-statistic: 0.3255 on 1 and 323 DF,  p-value: 0.5687
linearMod = lm(SpringFall08Winter09$previousrel ~ SpringFall08Winter09$`i$lap`)
summary(linearMod)
## 
## Call:
## lm(formula = SpringFall08Winter09$previousrel ~ SpringFall08Winter09$`i$lap`)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.9582 -0.9582  0.0474  1.0529 18.0418 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)   
## (Intercept)                   1.87535    0.64343   2.915  0.00381 **
## SpringFall08Winter09$`i$lap`  0.01656    0.15846   0.105  0.91683   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.053 on 323 degrees of freedom
##   (28 observations deleted due to missingness)
## Multiple R-squared:  3.382e-05,  Adjusted R-squared:  -0.003062 
## F-statistic: 0.01092 on 1 and 323 DF,  p-value: 0.9168

Does ideal affect predict current/past relationship love style?

Current relationship:

Ideal HAP does not predict currently being in an Eros relationship:

mylogit <- glm(currenteros ~ `i$hap`, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = currenteros ~ `i$hap`, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.7275  -0.7058  -0.6973  -0.6764   1.7899  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)  -1.5367     1.2079  -1.272    0.203
## `i$hap`       0.0685     0.3149   0.218    0.828
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 129.96  on 123  degrees of freedom
## Residual deviance: 129.91  on 122  degrees of freedom
##   (229 observations deleted due to missingness)
## AIC: 133.91
## 
## Number of Fisher Scoring iterations: 4

However, ideal LAP does (barely, p = 0.0511) predict currently being in an Eros relationship:

mylogit <- glm(currenteros ~ `i$lap`, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = currenteros ~ `i$lap`, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.1868  -0.7366  -0.6207  -0.5201   2.0335  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)  
## (Intercept)   0.9417     1.1371   0.828   0.4076  
## `i$lap`      -0.5748     0.2947  -1.951   0.0511 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 129.96  on 123  degrees of freedom
## Residual deviance: 126.10  on 122  degrees of freedom
##   (229 observations deleted due to missingness)
## AIC: 130.1
## 
## Number of Fisher Scoring iterations: 4
ggplot(data=SpringFall08Winter09, aes(x=`i$lap`, y=currenteros, na.rm=TRUE)) + geom_point() + 
  stat_smooth(method="glm", method.args=list(family="binomial")) +
  xlab("Ideal LAP") +
  ylab("Current Eros Relationship")
## Warning: Removed 229 rows containing non-finite values (stat_smooth).
## Warning: Removed 229 rows containing missing values (geom_point).

mylogit <- glm(currentstorge ~ `i$hap`, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = currentstorge ~ `i$hap`, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.152  -1.150  -1.149   1.205   1.206  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.054235   0.989485  -0.055    0.956
## `i$hap`     -0.002744   0.259162  -0.011    0.992
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 171.77  on 123  degrees of freedom
## Residual deviance: 171.77  on 122  degrees of freedom
##   (229 observations deleted due to missingness)
## AIC: 175.77
## 
## Number of Fisher Scoring iterations: 3

Ideal LAP predicts (p = 0.03) currently being in a Storge relationship:

mylogit <- glm(currentstorge ~ `i$lap`, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = currentstorge ~ `i$lap`, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.4049  -1.1603  -0.7689   1.1471   1.7942  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)  
## (Intercept)  -2.2839     1.0541  -2.167   0.0303 *
## `i$lap`       0.5609     0.2614   2.146   0.0319 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 171.77  on 123  degrees of freedom
## Residual deviance: 166.88  on 122  degrees of freedom
##   (229 observations deleted due to missingness)
## AIC: 170.88
## 
## Number of Fisher Scoring iterations: 4
ggplot(data=SpringFall08Winter09, aes(x=`i$lap`, y=currentstorge, na.rm=TRUE)) + geom_point() + 
  stat_smooth(method="glm", method.args=list(family="binomial")) +
  xlab("Ideal LAP") +
  ylab("Current Storge Relationship")
## Warning: Removed 229 rows containing non-finite values (stat_smooth).
## Warning: Removed 229 rows containing missing values (geom_point).

Past relationship love style:

mylogit <- glm(lasteros ~ `i$hap`, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = lasteros ~ `i$hap`, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.9970  -0.9207  -0.8670   1.4402   1.6191  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)  
## (Intercept)  -1.4336     0.7677  -1.867   0.0618 .
## `i$hap`       0.1987     0.2002   0.992   0.3210  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 308.53  on 241  degrees of freedom
## Residual deviance: 307.54  on 240  degrees of freedom
##   (111 observations deleted due to missingness)
## AIC: 311.54
## 
## Number of Fisher Scoring iterations: 4
mylogit <- glm(lasteros ~ `i$lap`, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = lasteros ~ `i$lap`, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.9063  -0.9036  -0.9009   1.4777   1.4875  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)  -0.7226     0.7450  -0.970    0.332
## `i$lap`       0.0090     0.1849   0.049    0.961
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 308.53  on 241  degrees of freedom
## Residual deviance: 308.53  on 240  degrees of freedom
##   (111 observations deleted due to missingness)
## AIC: 312.53
## 
## Number of Fisher Scoring iterations: 4
mylogit <- glm(laststorge ~ `i$hap`, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = laststorge ~ `i$hap`, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.7886  -0.7248  -0.6885  -0.6338   1.8675  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)  
## (Intercept)  -1.9784     0.8742  -2.263   0.0236 *
## `i$hap`       0.1940     0.2268   0.855   0.3925  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 256.93  on 241  degrees of freedom
## Residual deviance: 256.20  on 240  degrees of freedom
##   (111 observations deleted due to missingness)
## AIC: 260.2
## 
## Number of Fisher Scoring iterations: 4
mylogit <- glm(laststorge ~ `i$lap`, data = SpringFall08Winter09, family = "binomial")
summary(mylogit)
## 
## Call:
## glm(formula = laststorge ~ `i$lap`, family = "binomial", data = SpringFall08Winter09)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.8335  -0.7488  -0.6705  -0.5335   2.0100  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)   
## (Intercept)  -2.7519     0.9187  -2.995  0.00274 **
## `i$lap`       0.3746     0.2225   1.684  0.09215 . 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 256.93  on 241  degrees of freedom
## Residual deviance: 253.96  on 240  degrees of freedom
##   (111 observations deleted due to missingness)
## AIC: 257.96
## 
## Number of Fisher Scoring iterations: 4
ggplot(data=SpringFall08Winter09, aes(x=`i$lap`, y=laststorge, na.rm=TRUE)) + geom_point() + 
  stat_smooth(method="glm", method.args=list(family="binomial")) +
  xlab("Ideal LAP") +
  ylab("Past Storge Relationship")
## Warning: Removed 111 rows containing non-finite values (stat_smooth).
## Warning: Removed 111 rows containing missing values (geom_point).

Taken together, the above suggests that ideal LAP is generally a better (vs. ideal HAP) predictor of type of current (and marginally, past) relationship love type. Specifically, high ideal LAP predicted low current Eros and high current Storge

In this case, I think the fact that Storge was better predicted by ideal affect than Eros is largely an artifact of the data: we only had N=29 (out of 132) that were currently in an Eros relationship, whereas we had N=63 (out of 132) that were currently in a Stroge relationship.

Data on the last relationship was a bit more balanced, but still a restricted sample: N=85 (out of 254) had Eros Love for last relationship, whereas N=57 (out of 254) had Storge love for last relationship.

Future Directions

I think in the next study, I would like to recruit Asians instead of Asian Americans because in this sample the two cultures did not differ in ideal affect.