Getting ready:

library(tidyverse)
library(broom)

senses <- read_csv("winter_2016_senses_valence.csv")

Explore and describe the data

First some histograms:

senses %>% ggplot(aes(x = Val))+
  geom_histogram(binwidth = .25)+
  theme_bw()+
  facet_wrap(~Modality, nrow = 1)

And some dotplots:

senses %>% ggplot(aes(x = Modality, y = Val, shape = Modality, color = Modality)) +
  geom_point(alpha = .3)+
  stat_summary(fun.y = "mean", fun.ymin = "mean", fun.ymax= "mean", size= 0.3, geom = "crossbar") +
  theme_bw()
`fun.y` is deprecated. Use `fun` instead.`fun.ymin` is deprecated. Use `fun.min` instead.`fun.ymax` is deprecated. Use `fun.max` instead.

Finally, some summary stats by modality:

senses %>% group_by(Modality) %>% summarise(mean = mean(Val),
                                            sd = sd(Val),
                                            min = min(Val),
                                            max = max(Val))

Working with a 2-level categorical variable

Let’s create a smaller dataset with only Taste and Smell modalities:

chem <- filter(senses, Modality %in% c('Taste', 'Smell'))

table(chem$Modality)

Smell Taste 
   25    47 

Now for a regression model:

chem_mdl <- lm(Val ~ Modality, data = chem)

summary(chem_mdl)

Call:
lm(formula = Val ~ Modality, data = chem)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.99315 -0.20870  0.04343  0.19115  0.62788 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)    5.47101    0.06297  86.889  < 2e-16 ***
ModalityTaste  0.33711    0.07793   4.326 4.95e-05 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.3148 on 70 degrees of freedom
Multiple R-squared:  0.2109,    Adjusted R-squared:  0.1997 
F-statistic: 18.71 on 1 and 70 DF,  p-value: 4.951e-05

We can infer that Smell is the reference category. Let’s play with a couple different ways to do treatment coding:

chem <- chem %>% mutate(Mod01 = if_else(Modality == "Taste", 1, 0),
                        Mod10 = if_else(Modality == "Smell", 1, 0),
                        Modality = factor(Modality),
                        ModRe = relevel(Modality, ref = 'Taste'))

And now for some models…

chem_mdl01 <- lm(Val ~ Mod01, data = chem)
chem_mdl10 <- lm(Val ~ Mod10, data = chem)
chem_mdlFac <- lm(Val ~ Modality, data = chem)
chem_mdlRe <- lm(Val ~ ModRe, data = chem)

Take a peek at the summaries and coefficient values…

#fit summary
glance(chem_mdl01)$r.squared
[1] 0.2109257
glance(chem_mdl10)$r.squared
[1] 0.2109257
glance(chem_mdlFac)$r.squared
[1] 0.2109257
glance(chem_mdlRe)$r.squared
[1] 0.2109257
#coefficients
tidy(chem_mdl01)$estimate
[1] 5.4710116 0.3371123
tidy(chem_mdl10)$estimate
[1]  5.8081239 -0.3371123
tidy(chem_mdlFac)$estimate
[1] 5.4710116 0.3371123
tidy(chem_mdlRe)$estimate
[1]  5.8081239 -0.3371123

Now let’s try Modality with sum contrasts:

chem <- mutate(chem, ModSum = Modality)

contrasts(chem$ModSum) <- contr.sum(2)

chem_mdlSum <- lm(Val ~ ModSum, data = chem)

summary(chem_mdlSum)

Call:
lm(formula = Val ~ ModSum, data = chem)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.99315 -0.20870  0.04343  0.19115  0.62788 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  5.63957    0.03897 144.729  < 2e-16 ***
ModSum1     -0.16856    0.03897  -4.326 4.95e-05 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.3148 on 70 degrees of freedom
Multiple R-squared:  0.2109,    Adjusted R-squared:  0.1997 
F-statistic: 18.71 on 1 and 70 DF,  p-value: 4.951e-05

Note that R^2, F-stat, etc. are the same even though intercept and slope differ.

t-test

t.test(Val ~ Modality, data = chem, var.equal = T)

    Two Sample t-test

data:  Val by Modality
t = -4.3257, df = 70, p-value = 4.951e-05
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -0.4925442 -0.1816804
sample estimates:
mean in group Smell mean in group Taste 
           5.471012            5.808124 

Same p-value as regression model!

A predictor with more than 2 categories

Now we’ll take a look at the whole dataset, which has 5 categories for sense modalities.

sense_all <- lm(Val ~ Modality, data = senses)

summary(sense_all)

Call:
lm(formula = Val ~ Modality, data = senses)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.99315 -0.16482 -0.02158  0.15920  1.15734 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)    5.57966    0.01889 295.308  < 2e-16 ***
ModalitySmell -0.10865    0.05643  -1.925   0.0549 .  
ModalitySound -0.17447    0.03758  -4.643 4.66e-06 ***
ModalityTaste  0.22846    0.04314   5.296 1.96e-07 ***
ModalityTouch -0.04523    0.03737  -1.210   0.2269    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.2659 on 400 degrees of freedom
Multiple R-squared:  0.1455,    Adjusted R-squared:  0.137 
F-statistic: 17.03 on 4 and 400 DF,  p-value: 6.616e-13

To compare: ANOVA

Now for the ANOVA approach:

aov_senses <- aov(Val ~ Modality, data = senses)

summary(aov_senses)
             Df Sum Sq Mean Sq F value   Pr(>F)    
Modality      4  4.815  1.2036   17.03 6.62e-13 ***
Residuals   400 28.274  0.0707                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Same model fit - F-stat and p.val are identical.

getting at the contrasts…

The emmeans package is helpful for extracting model contrasts of interest when working with categorical variables.

library(emmeans)

We’ll first use the emmeans() function to get the model-based estimates for each category, then use that information to make pairwise comparisons among the categories.

sense_all_emm <- emmeans(sense_all, "Modality")

sense_all_emm
 Modality emmean     SE  df lower.CL upper.CL
 Sight      5.58 0.0189 400     5.54     5.62
 Smell      5.47 0.0532 400     5.37     5.58
 Sound      5.41 0.0325 400     5.34     5.47
 Taste      5.81 0.0388 400     5.73     5.88
 Touch      5.53 0.0322 400     5.47     5.60

Confidence level used: 0.95 

And then…

pairs(sense_all_emm)
 contrast      estimate     SE  df t.ratio p.value
 Sight - Smell   0.1087 0.0564 400  1.925  0.3055 
 Sight - Sound   0.1745 0.0376 400  4.643  <.0001 
 Sight - Taste  -0.2285 0.0431 400 -5.296  <.0001 
 Sight - Touch   0.0452 0.0374 400  1.210  0.7454 
 Smell - Sound   0.0658 0.0623 400  1.056  0.8287 
 Smell - Taste  -0.3371 0.0658 400 -5.122  <.0001 
 Smell - Touch  -0.0634 0.0622 400 -1.020  0.8461 
 Sound - Taste  -0.4029 0.0506 400 -7.965  <.0001 
 Sound - Touch  -0.1292 0.0458 400 -2.824  0.0397 
 Taste - Touch   0.2737 0.0504 400  5.427  <.0001 

P value adjustment: tukey method for comparing a family of 5 estimates 

You can do the same thing with the ANOVA model, too!

LS0tDQp0aXRsZTogIkNhdGVnb3JpYWwgUHJlZGljdG9ycyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCkdldHRpbmcgcmVhZHk6DQoNCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmxpYnJhcnkoYnJvb20pDQoNCnNlbnNlcyA8LSByZWFkX2Nzdigid2ludGVyXzIwMTZfc2Vuc2VzX3ZhbGVuY2UuY3N2IikNCmBgYA0KDQojIEV4cGxvcmUgYW5kIGRlc2NyaWJlIHRoZSBkYXRhDQoNCkZpcnN0IHNvbWUgaGlzdG9ncmFtczoNCg0KYGBge3J9DQpzZW5zZXMgJT4lIGdncGxvdChhZXMoeCA9IFZhbCkpKw0KICBnZW9tX2hpc3RvZ3JhbShiaW53aWR0aCA9IC4yNSkrDQogIHRoZW1lX2J3KCkrDQogIGZhY2V0X3dyYXAofk1vZGFsaXR5LCBucm93ID0gMSkNCmBgYA0KQW5kIHNvbWUgZG90cGxvdHM6DQoNCmBgYHtyfQ0Kc2Vuc2VzICU+JSBnZ3Bsb3QoYWVzKHggPSBNb2RhbGl0eSwgeSA9IFZhbCwgc2hhcGUgPSBNb2RhbGl0eSwgY29sb3IgPSBNb2RhbGl0eSkpICsNCiAgZ2VvbV9wb2ludChhbHBoYSA9IC4zKSsNCiAgc3RhdF9zdW1tYXJ5KGZ1bi55ID0gIm1lYW4iLCBmdW4ueW1pbiA9ICJtZWFuIiwgZnVuLnltYXg9ICJtZWFuIiwgc2l6ZT0gMC4zLCBnZW9tID0gImNyb3NzYmFyIikgKw0KICB0aGVtZV9idygpDQpgYGANCg0KRmluYWxseSwgc29tZSBzdW1tYXJ5IHN0YXRzIGJ5IG1vZGFsaXR5Og0KDQpgYGB7cn0NCnNlbnNlcyAlPiUgZ3JvdXBfYnkoTW9kYWxpdHkpICU+JSBzdW1tYXJpc2UobWVhbiA9IG1lYW4oVmFsKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2QgPSBzZChWYWwpLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBtaW4gPSBtaW4oVmFsKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbWF4ID0gbWF4KFZhbCkpDQpgYGANCg0KIyBXb3JraW5nIHdpdGggYSAyLWxldmVsIGNhdGVnb3JpY2FsIHZhcmlhYmxlDQoNCkxldCdzIGNyZWF0ZSBhIHNtYWxsZXIgZGF0YXNldCB3aXRoIG9ubHkgVGFzdGUgYW5kIFNtZWxsIG1vZGFsaXRpZXM6DQoNCmBgYHtyfQ0KY2hlbSA8LSBmaWx0ZXIoc2Vuc2VzLCBNb2RhbGl0eSAlaW4lIGMoJ1Rhc3RlJywgJ1NtZWxsJykpDQoNCnRhYmxlKGNoZW0kTW9kYWxpdHkpDQpgYGANCg0KTm93IGZvciBhIHJlZ3Jlc3Npb24gbW9kZWw6DQoNCmBgYHtyfQ0KY2hlbV9tZGwgPC0gbG0oVmFsIH4gTW9kYWxpdHksIGRhdGEgPSBjaGVtKQ0KDQpzdW1tYXJ5KGNoZW1fbWRsKQ0KYGBgDQoNCldlIGNhbiBpbmZlciB0aGF0IFNtZWxsIGlzIHRoZSByZWZlcmVuY2UgY2F0ZWdvcnkuIExldCdzIHBsYXkgd2l0aCBhIGNvdXBsZSBkaWZmZXJlbnQgd2F5cyB0byBkbyB0cmVhdG1lbnQgY29kaW5nOg0KDQpgYGB7cn0NCmNoZW0gPC0gY2hlbSAlPiUgbXV0YXRlKE1vZDAxID0gaWZfZWxzZShNb2RhbGl0eSA9PSAiVGFzdGUiLCAxLCAwKSwNCiAgICAgICAgICAgICAgICAgICAgICAgIE1vZDEwID0gaWZfZWxzZShNb2RhbGl0eSA9PSAiU21lbGwiLCAxLCAwKSwNCiAgICAgICAgICAgICAgICAgICAgICAgIE1vZGFsaXR5ID0gZmFjdG9yKE1vZGFsaXR5KSwNCiAgICAgICAgICAgICAgICAgICAgICAgIE1vZFJlID0gcmVsZXZlbChNb2RhbGl0eSwgcmVmID0gJ1Rhc3RlJykpDQpgYGANCg0KQW5kIG5vdyBmb3Igc29tZSBtb2RlbHMuLi4NCg0KYGBge3J9DQpjaGVtX21kbDAxIDwtIGxtKFZhbCB+IE1vZDAxLCBkYXRhID0gY2hlbSkNCmNoZW1fbWRsMTAgPC0gbG0oVmFsIH4gTW9kMTAsIGRhdGEgPSBjaGVtKQ0KY2hlbV9tZGxGYWMgPC0gbG0oVmFsIH4gTW9kYWxpdHksIGRhdGEgPSBjaGVtKQ0KY2hlbV9tZGxSZSA8LSBsbShWYWwgfiBNb2RSZSwgZGF0YSA9IGNoZW0pDQpgYGANCg0KVGFrZSBhIHBlZWsgYXQgdGhlIHN1bW1hcmllcyBhbmQgY29lZmZpY2llbnQgdmFsdWVzLi4uDQoNCmBgYHtyfQ0KI2ZpdCBzdW1tYXJ5DQpnbGFuY2UoY2hlbV9tZGwwMSkkci5zcXVhcmVkDQpnbGFuY2UoY2hlbV9tZGwxMCkkci5zcXVhcmVkDQpnbGFuY2UoY2hlbV9tZGxGYWMpJHIuc3F1YXJlZA0KZ2xhbmNlKGNoZW1fbWRsUmUpJHIuc3F1YXJlZA0KDQojY29lZmZpY2llbnRzDQp0aWR5KGNoZW1fbWRsMDEpJGVzdGltYXRlDQp0aWR5KGNoZW1fbWRsMTApJGVzdGltYXRlDQp0aWR5KGNoZW1fbWRsRmFjKSRlc3RpbWF0ZQ0KdGlkeShjaGVtX21kbFJlKSRlc3RpbWF0ZQ0KYGBgDQpOb3cgbGV0J3MgdHJ5IE1vZGFsaXR5IHdpdGggc3VtIGNvbnRyYXN0czoNCg0KYGBge3J9DQpjaGVtIDwtIG11dGF0ZShjaGVtLCBNb2RTdW0gPSBNb2RhbGl0eSkNCg0KY29udHJhc3RzKGNoZW0kTW9kU3VtKSA8LSBjb250ci5zdW0oMikNCg0KY2hlbV9tZGxTdW0gPC0gbG0oVmFsIH4gTW9kU3VtLCBkYXRhID0gY2hlbSkNCg0Kc3VtbWFyeShjaGVtX21kbFN1bSkNCmBgYA0KTm90ZSB0aGF0IFJeMiwgRi1zdGF0LCBldGMuIGFyZSB0aGUgc2FtZSBldmVuIHRob3VnaCBpbnRlcmNlcHQgYW5kIHNsb3BlIGRpZmZlci4NCg0KIyMgdC10ZXN0DQoNCmBgYHtyfQ0KdC50ZXN0KFZhbCB+IE1vZGFsaXR5LCBkYXRhID0gY2hlbSwgdmFyLmVxdWFsID0gVCkNCmBgYA0KU2FtZSBwLXZhbHVlIGFzIHJlZ3Jlc3Npb24gbW9kZWwhDQoNCiMgQSBwcmVkaWN0b3Igd2l0aCBtb3JlIHRoYW4gMiBjYXRlZ29yaWVzDQoNCk5vdyB3ZSdsbCB0YWtlIGEgbG9vayBhdCB0aGUgd2hvbGUgZGF0YXNldCwgd2hpY2ggaGFzIDUgY2F0ZWdvcmllcyBmb3Igc2Vuc2UgbW9kYWxpdGllcy4NCg0KYGBge3J9DQpzZW5zZV9hbGwgPC0gbG0oVmFsIH4gTW9kYWxpdHksIGRhdGEgPSBzZW5zZXMpDQoNCnN1bW1hcnkoc2Vuc2VfYWxsKQ0KYGBgDQojIyBUbyBjb21wYXJlOiBBTk9WQQ0KDQpOb3cgZm9yIHRoZSBBTk9WQSBhcHByb2FjaDoNCg0KYGBge3J9DQphb3Zfc2Vuc2VzIDwtIGFvdihWYWwgfiBNb2RhbGl0eSwgZGF0YSA9IHNlbnNlcykNCg0Kc3VtbWFyeShhb3Zfc2Vuc2VzKQ0KYGBgDQpTYW1lIG1vZGVsIGZpdCAtIEYtc3RhdCBhbmQgcC52YWwgYXJlIGlkZW50aWNhbC4NCg0KIyMgZ2V0dGluZyBhdCB0aGUgY29udHJhc3RzLi4uDQoNClRoZSBgZW1tZWFuc2AgcGFja2FnZSBpcyBoZWxwZnVsIGZvciBleHRyYWN0aW5nIG1vZGVsIGNvbnRyYXN0cyBvZiBpbnRlcmVzdCB3aGVuIHdvcmtpbmcgd2l0aCBjYXRlZ29yaWNhbCB2YXJpYWJsZXMuIA0KYGBge3J9DQpsaWJyYXJ5KGVtbWVhbnMpDQpgYGANCg0KV2UnbGwgZmlyc3QgdXNlIHRoZSBgZW1tZWFucygpYCBmdW5jdGlvbiB0byBnZXQgdGhlIG1vZGVsLWJhc2VkIGVzdGltYXRlcyBmb3IgZWFjaCBjYXRlZ29yeSwgdGhlbiB1c2UgdGhhdCBpbmZvcm1hdGlvbiB0byBtYWtlIHBhaXJ3aXNlIGNvbXBhcmlzb25zIGFtb25nIHRoZSBjYXRlZ29yaWVzLg0KDQpgYGB7cn0NCnNlbnNlX2FsbF9lbW0gPC0gZW1tZWFucyhzZW5zZV9hbGwsICJNb2RhbGl0eSIpDQoNCnNlbnNlX2FsbF9lbW0NCmBgYA0KQW5kIHRoZW4uLi4NCg0KYGBge3J9DQpwYWlycyhzZW5zZV9hbGxfZW1tKSAjIyB1c2VzIFR1a2V5J3MgdGVzdCBmb3IgYWRqdXN0aW5nIHAtdmFsdWVzDQpgYGANCg0KWW91IGNhbiBkbyB0aGUgc2FtZSB0aGluZyB3aXRoIHRoZSBBTk9WQSBtb2RlbCwgdG9vIQ==