Facebook Attraction

In this WPA, you will analyze data from a (again…fake) study on attraction. In the study, 1000 heterosexual University students viewed the Facebook profile of another student (the “target”) of the opposite sex. Based on a target’s profile, each participant made three judgments about the target - intelligence, attractiveness, and dateability. The primary judgement was a dateability rating indicating how dateable the person was on a scale of 0 to 100.

facebook <- read.table("http://nathanieldphillips.com/wp-content/uploads/2016/04/facebook.txt", sep = "\t", header = TRUE)

The data are located in a tab-delimited text file at http://nathanieldphillips.com/wp-content/uploads/2016/04/facebook.txt. Here is how the first few rows of the data should look:

head(facebook)
##   session sex age haircolor university    education shirtless intelligence
## 1       1   m  23     brown   3.Geneva    3.Masters     2.Yes        1.low
## 2       1   m  19    blonde   2.Zurich 1.HighSchool      1.No     2.medium
## 3       1   f  22     brown   2.Zurich  2.Bachelors     2.Yes        1.low
## 4       1   f  22       red   2.Zurich  2.Bachelors      1.No     2.medium
## 5       1   m  23     brown   3.Geneva  2.Bachelors      1.No     2.medium
## 6       1   m  26    blonde   2.Zurich    3.Masters     2.Yes       3.high
##   attractiveness dateability
## 1         3.high          15
## 2       2.medium          44
## 3       2.medium         100
## 4         3.high         100
## 5       2.medium          63
## 6         3.high          76

Datafile description

The data file has 1000 rows and 10 columns. Here are the columns

Data loading and preparation

  1. Open your class R project. Open a new script and enter your name, date, and the wpa number at the top. Save the script in the R folder in your project working directory as wpa_7_LASTFIRST.R, where LAST and FIRST are your last and first names.

  2. The data are stored in a tab–delimited text file located at http://nathanieldphillips.com/wp-content/uploads/2016/04/facebook.txt. Using read.table() load this data into R as a new object called facebook

Understand the data

  1. Look at the first few rows of the dataframe with the head() function to make sure it loaded correctly.
head(facebook)
##   session sex age haircolor university    education shirtless intelligence
## 1       1   m  23     brown   3.Geneva    3.Masters     2.Yes        1.low
## 2       1   m  19    blonde   2.Zurich 1.HighSchool      1.No     2.medium
## 3       1   f  22     brown   2.Zurich  2.Bachelors     2.Yes        1.low
## 4       1   f  22       red   2.Zurich  2.Bachelors      1.No     2.medium
## 5       1   m  23     brown   3.Geneva  2.Bachelors      1.No     2.medium
## 6       1   m  26    blonde   2.Zurich    3.Masters     2.Yes       3.high
##   attractiveness dateability
## 1         3.high          15
## 2       2.medium          44
## 3       2.medium         100
## 4         3.high         100
## 5       2.medium          63
## 6         3.high          76
  1. Using the str() function, look at the structure of the dataframe to make sure everything looks ok
str(facebook)
## 'data.frame':    1000 obs. of  10 variables:
##  $ session       : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ sex           : Factor w/ 2 levels "f","m": 2 2 1 1 2 2 1 2 1 1 ...
##  $ age           : int  23 19 22 22 23 26 19 25 22 19 ...
##  $ haircolor     : Factor w/ 3 levels "blonde","brown",..: 2 1 2 3 2 1 2 3 2 1 ...
##  $ university    : Factor w/ 3 levels "1.Basel","2.Zurich",..: 3 2 2 2 3 2 3 2 2 3 ...
##  $ education     : Factor w/ 4 levels "1.HighSchool",..: 3 1 2 2 2 3 1 3 2 1 ...
##  $ shirtless     : Factor w/ 2 levels "1.No","2.Yes": 2 1 2 1 1 2 1 2 2 1 ...
##  $ intelligence  : Factor w/ 3 levels "1.low","2.medium",..: 1 2 1 2 2 3 1 3 2 2 ...
##  $ attractiveness: Factor w/ 3 levels "1.low","2.medium",..: 3 2 2 3 2 3 2 1 2 2 ...
##  $ dateability   : int  15 44 100 100 63 76 61 26 76 40 ...

Answer guidelines Read carefully to save yourself time!

For example, here is how I would analyze and answer the question: “Was there an effect of diets on Chicken Weights?”"

# ANOVA on Chicken Weights
#   IV = Diet, DV = weight

# ANOVA
p0.aov <- aov(formula = weight ~ Diet,
            data = ChickWeight)

summary(p0.aov)
##              Df  Sum Sq Mean Sq F value   Pr(>F)    
## Diet          3  155863   51954   10.81 6.43e-07 ***
## Residuals   574 2758693    4806                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# ANOVA was significant (p < .01), so I'll conduct post-hoc tests

# Tukey post-hoc tests
TukeyHSD(p0.aov)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = weight ~ Diet, data = ChickWeight)
## 
## $Diet
##          diff         lwr      upr     p adj
## 2-1 19.971212  -0.2998092 40.24223 0.0552271
## 3-1 40.304545  20.0335241 60.57557 0.0000025
## 4-1 32.617257  12.2353820 52.99913 0.0002501
## 3-2 20.333333  -2.7268370 43.39350 0.1058474
## 4-2 12.646045 -10.5116315 35.80372 0.4954239
## 4-3 -7.687288 -30.8449649 15.47039 0.8277810

Answer: There was a significant main effect of diets on chicken weights (F(3, 574) = 10.81, p < .01). Pairwise Tukey HSD tests showed significant differences between diets 1 and 3 (diff = 40.30, p < .01) and diets 1 and 4 (diff = 32.62, p < .01). All other pairwise differences were not significant at the 0.05 significance threshold.

One-way ANOVAS

  1. Was there a main effect of the university on dateability? Conduct a one-way ANOVA. If the result is significant (p < .05), conduct post-hoc tests
p5.aov <- aov(formula = dateability ~ university,
            data = facebook)

summary(p5.aov)
##              Df Sum Sq Mean Sq F value   Pr(>F)    
## university    2  19769    9884   13.99 1.01e-06 ***
## Residuals   997 704173     706                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
TukeyHSD(p5.aov)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = dateability ~ university, data = facebook)
## 
## $university
##                         diff        lwr       upr     p adj
## 2.Zurich-1.Basel  -10.275500 -15.099617 -5.451383 0.0000020
## 3.Geneva-1.Basel   -8.641689 -13.586611 -3.696767 0.0001311
## 3.Geneva-2.Zurich   1.633811  -3.122189  6.389811 0.6991862

Answer: There was a significant main effect of university on dateability (F(2, 997) = 13.99, p < .01). Pairwise Tukey HSD tests showed significant differences between Zurich and Basel (diff = -10.27, p < .01) and Geneva and Basel (diff = -8.64, p < .01). All other pairwise differences were not significant at the 0.05 significance threshold.

  1. Was there a main effect of intelligence on dateability? Conduct a one-way ANOVA. If the result is significant (p < .05), conduct post-hoc tests
p6.aov <- aov(formula = dateability ~ intelligence,
            data = facebook)

summary(p6.aov)
##               Df Sum Sq Mean Sq F value Pr(>F)   
## intelligence   2   7070    3535   4.917 0.0075 **
## Residuals    997 716871     719                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
TukeyHSD(p6.aov)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = dateability ~ intelligence, data = facebook)
## 
## $intelligence
##                      diff       lwr       upr     p adj
## 2.medium-1.low   6.535264  1.615557 11.454970 0.0053173
## 3.high-1.low     2.865833 -2.070710  7.802375 0.3610523
## 3.high-2.medium -3.669431 -8.458242  1.119380 0.1705679

Answer: There was a significant main effect of intelligence on dateability (F(2, 997) = 4.97, p < .01). Pairwise Tukey HSD tests showed significant differences between Medium and Low intelligence (diff = 6.53, p < .01). All other pairwise differences were not significant at the 0.05 significance threshold.

  1. Was there a main effect of haircolor on dateability? Conduct a one-way ANOVA. If the result is significant (p < .05), conduct post-hoc tests
p7.aov <- aov(formula = dateability ~ haircolor,
            data = facebook)

summary(p7.aov)
##              Df Sum Sq Mean Sq F value Pr(>F)
## haircolor     2   1779   889.7   1.228  0.293
## Residuals   997 722162   724.3

Answer: There was no significant main effect of haircolor on dateability (F(2, 997) = 1.23, p = 0.29).

Multi-independent ANOVAs

  1. Conduct a three-way ANOVA on dateability with both intelligence, university and haircolor as IVs. Do your results for each variable change compared to your previous one-way ANOVAs on these variables? (You do not need to give APA results or conduct post-hoc tests, just answer the question verbally).
p8.aov <- aov(formula = dateability ~ intelligence + university + haircolor,
            data = facebook)

summary(p8.aov)
##               Df Sum Sq Mean Sq F value   Pr(>F)    
## intelligence   2   7070    3535   5.043  0.00662 ** 
## university     2  18838    9419  13.436 1.75e-06 ***
## haircolor      2   1921     960   1.370  0.25462    
## Residuals    993 696112     701                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Answer: Yes the results are the same!

  1. Conduct a multi-way anova including sex, haircolor, university, education, shirtless, intelligence and attractiveness as independent variables predicting dateability. WHich variables are significantly related to dateability? (Do write APA results for each variable but do not conduct post-hoc tests).
p9.aov <- aov(formula = dateability ~ sex + haircolor + university + education + shirtless + intelligence + attractiveness,
            data = facebook)

summary(p9.aov)
##                 Df Sum Sq Mean Sq F value   Pr(>F)    
## sex              1  36514   36514  66.103 1.28e-15 ***
## haircolor        2   1869     935   1.692  0.18466    
## university       2  19172    9586  17.354 3.92e-08 ***
## education        3   3186    1062   1.922  0.12424    
## shirtless        1    106     106   0.192  0.66106    
## intelligence     2   5904    2952   5.345  0.00491 ** 
## attractiveness   2 112544   56272 101.872  < 2e-16 ***
## Residuals      986 544646     552                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Answer: There were significant effects of sex (F(1, 986) = 66.10, p < .01), university (F(2, 986) = 17.35, p < .01), intelligence (F(2, 986) = 5.34, p < .01) and attractiveness (F(2, 986) = 101.87, p < .01).

ANOVAs on subsets of data

  1. It turns out that the experimenter who ran sessions 1 through 30 (a man) was trying to score a date and slipped in his own profile picture into the study. We can’t trust these data. Repeat your multi anova from question 9 ONLY for sessions 31 through 50. Do your conclusions change compared to when you analyzed the data from all sessions?
p10.aov <- aov(formula = dateability ~ sex + haircolor + university + education + shirtless + intelligence + attractiveness,
            data = subset(facebook, session > 30))

summary(p10.aov)
##                 Df Sum Sq Mean Sq F value   Pr(>F)    
## sex              1   6933    6933  12.425 0.000474 ***
## haircolor        2   2459    1230   2.203 0.111806    
## university       2  12099    6050  10.842 2.62e-05 ***
## education        3   2059     686   1.230 0.298479    
## shirtless        1    184     184   0.330 0.565884    
## intelligence     2    543     271   0.487 0.615135    
## attractiveness   2  36084   18042  32.334 1.04e-13 ***
## Residuals      386 215386     558                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Intelligence is no longer significant :(

Interactions

  1. Create a plot (e.g.; pirateplot(), barplot(), boxplot()) showing the distribution of dateability based on two independent variables: sex and shirtless. Based on what you see in the plot, do you expect there to be an interaction between sex and shirtless? Why or why not?
library(yarrr)
pirateplot(dateability ~ sex + shirtless, 
           data = facebook)

# Yes there looks like an intereaction!
  1. Test your prediction with the appropriate ANOVA
p12.aov <- aov(dateability ~ sex * shirtless, 
            data = facebook)
            
summary(p12.aov)
##                Df Sum Sq Mean Sq F value   Pr(>F)    
## sex             1  36514   36514  62.689 6.43e-15 ***
## shirtless       1    247     247   0.425    0.515    
## sex:shirtless   1 107048  107048 183.786  < 2e-16 ***
## Residuals     996 580132     582                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Yep I was right!

CHECKPOINT!

More interactions

  1. Create a plot (e.g.; pirateplot(), barplot(), boxplot()) showing the distribution of dateability based on two independent variables: university and education. Based on what you see in the plot, do you expect there to be an interaction between university and education? Why or why not?
pirateplot(dateability ~ university + education, 
           data = facebook)

# No there does not look like an interaction!
  1. Test your prediction with the appropriate ANOVA
p14.aov <- aov(dateability ~ university * education, 
               data = facebook)

summary(p14.aov)
##                       Df Sum Sq Mean Sq F value   Pr(>F)    
## university             2  19769    9884  13.979 1.03e-06 ***
## education              3   3442    1147   1.623    0.182    
## university:education   6   2145     357   0.506    0.804    
## Residuals            988 698586     707                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# I was right again!
  1. Create a plot (e.g.; pirateplot(), barplot(), boxplot()) showing the distribution of dateability based on two independent variables: university and haircolor. Based on what you see in the plot, do you expect there to be an interaction between university and intelligence? Why or why not?
pirateplot(dateability ~ university + haircolor, 
           data = facebook)

# There does not look like an interaction
  1. Test your prediction with the appropriate ANOVA
p22.aov <- aov(dateability ~ university * haircolor, 
           data = facebook)

summary(p22.aov)
##                       Df Sum Sq Mean Sq F value   Pr(>F)    
## university             2  19769    9884  13.967 1.04e-06 ***
## haircolor              2   1647     823   1.163    0.313    
## university:haircolor   4   1217     304   0.430    0.787    
## Residuals            991 701309     708                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Yep! no significant interaction!

Submit!

Save and email your wpa_7_LastFirst.R file to me at nathaniel.phillips@unibas.ch. Then, go to https://goo.gl/forms/UblvQ6dvA76veEWu1 to complete the WPA submission form.