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()

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 between group Smell and group Taste 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 easystats package includes the modelbased package, which is helpful for extracting model contrasts of interest when working with categorical variables.

library(easystats)

We’ll first use the estimate_means() function to get the model-based estimates for each category. Thse are useful to report as descriptive statistics, or for plotting.

sense_all_means <- estimate_means(sense_all, by = "Modality")

sense_all_means
Estimated Marginal Means

Modality | Mean |   SE |       95% CI | t(400)
----------------------------------------------
Sight    | 5.58 | 0.02 | [5.54, 5.62] | 295.31
Smell    | 5.47 | 0.05 | [5.37, 5.58] | 102.89
Sound    | 5.41 | 0.03 | [5.34, 5.47] | 166.41
Taste    | 5.81 | 0.04 | [5.73, 5.88] | 149.77
Touch    | 5.53 | 0.03 | [5.47, 5.60] | 171.66

Variable predicted: Val
Predictors modulated: Modality
plot(sense_all_means)

We can use the estimate_contrasts() function to examine pairwise differences among categorial variables.

sense_all_contrasts <- estimate_contrasts(sense_all, contrast = "Modality",
                                          p_adjust = "tukey")

sense_all_contrasts
Marginal Contrasts Analysis

Level1 | Level2 | Difference |   SE |         95% CI | t(400) |      p
----------------------------------------------------------------------
Smell  | Sight  |      -0.11 | 0.06 | [-0.22,  0.00] |  -1.93 |  0.306
Sound  | Sight  |      -0.17 | 0.04 | [-0.25, -0.10] |  -4.64 | < .001
Taste  | Sight  |       0.23 | 0.04 | [ 0.14,  0.31] |   5.30 | < .001
Touch  | Sight  |      -0.05 | 0.04 | [-0.12,  0.03] |  -1.21 |  0.745
Sound  | Smell  |      -0.07 | 0.06 | [-0.19,  0.06] |  -1.06 |  0.829
Taste  | Smell  |       0.34 | 0.07 | [ 0.21,  0.47] |   5.12 | < .001
Touch  | Smell  |       0.06 | 0.06 | [-0.06,  0.19] |   1.02 |  0.846
Taste  | Sound  |       0.40 | 0.05 | [ 0.30,  0.50] |   7.97 | < .001
Touch  | Sound  |       0.13 | 0.05 | [ 0.04,  0.22] |   2.82 |  0.040
Touch  | Taste  |      -0.27 | 0.05 | [-0.37, -0.17] |  -5.43 | < .001

Variable predicted: Val
Predictors contrasted: Modality
p-value adjustment method: Tukey

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

LS0tDQp0aXRsZTogIkNhdGVnb3JpYWwgUHJlZGljdG9ycyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCkdldHRpbmcgcmVhZHk6DQoNCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmxpYnJhcnkoYnJvb20pDQoNCnNlbnNlcyA8LSByZWFkX2Nzdigid2ludGVyXzIwMTZfc2Vuc2VzX3ZhbGVuY2UuY3N2IikNCmBgYA0KDQojIEV4cGxvcmUgYW5kIGRlc2NyaWJlIHRoZSBkYXRhDQoNCkZpcnN0IHNvbWUgaGlzdG9ncmFtczoNCg0KYGBge3J9DQpzZW5zZXMgJT4lIGdncGxvdChhZXMoeCA9IFZhbCkpKw0KICBnZW9tX2hpc3RvZ3JhbShiaW53aWR0aCA9IC4yNSkrDQogIHRoZW1lX2J3KCkrDQogIGZhY2V0X3dyYXAofk1vZGFsaXR5LCBucm93ID0gMSkNCmBgYA0KQW5kIHNvbWUgZG90cGxvdHM6DQoNCmBgYHtyfQ0Kc2Vuc2VzICU+JSBnZ3Bsb3QoYWVzKHggPSBNb2RhbGl0eSwgeSA9IFZhbCwgc2hhcGUgPSBNb2RhbGl0eSwgY29sb3IgPSBNb2RhbGl0eSkpICsNCiAgZ2VvbV9wb2ludChhbHBoYSA9IC4zKSsNCiAgc3RhdF9zdW1tYXJ5KGZ1bi55ID0gIm1lYW4iLCBmdW4ueW1pbiA9ICJtZWFuIiwgZnVuLnltYXg9ICJtZWFuIiwgc2l6ZT0gMC4zLCBnZW9tID0gImNyb3NzYmFyIikgKw0KICB0aGVtZV9idygpDQpgYGANCg0KRmluYWxseSwgc29tZSBzdW1tYXJ5IHN0YXRzIGJ5IG1vZGFsaXR5Og0KDQpgYGB7cn0NCnNlbnNlcyAlPiUgZ3JvdXBfYnkoTW9kYWxpdHkpICU+JSBzdW1tYXJpc2UobWVhbiA9IG1lYW4oVmFsKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2QgPSBzZChWYWwpLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBtaW4gPSBtaW4oVmFsKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbWF4ID0gbWF4KFZhbCkpDQpgYGANCg0KIyBXb3JraW5nIHdpdGggYSAyLWxldmVsIGNhdGVnb3JpY2FsIHZhcmlhYmxlDQoNCkxldCdzIGNyZWF0ZSBhIHNtYWxsZXIgZGF0YXNldCB3aXRoIG9ubHkgVGFzdGUgYW5kIFNtZWxsIG1vZGFsaXRpZXM6DQoNCmBgYHtyfQ0KY2hlbSA8LSBmaWx0ZXIoc2Vuc2VzLCBNb2RhbGl0eSAlaW4lIGMoJ1Rhc3RlJywgJ1NtZWxsJykpDQoNCnRhYmxlKGNoZW0kTW9kYWxpdHkpDQpgYGANCg0KTm93IGZvciBhIHJlZ3Jlc3Npb24gbW9kZWw6DQoNCmBgYHtyfQ0KY2hlbV9tZGwgPC0gbG0oVmFsIH4gTW9kYWxpdHksIGRhdGEgPSBjaGVtKQ0KDQpzdW1tYXJ5KGNoZW1fbWRsKQ0KYGBgDQoNCldlIGNhbiBpbmZlciB0aGF0IFNtZWxsIGlzIHRoZSByZWZlcmVuY2UgY2F0ZWdvcnkuIExldCdzIHBsYXkgd2l0aCBhIGNvdXBsZSBkaWZmZXJlbnQgd2F5cyB0byBkbyB0cmVhdG1lbnQgY29kaW5nOg0KDQpgYGB7cn0NCmNoZW0gPC0gY2hlbSAlPiUgbXV0YXRlKE1vZDAxID0gaWZfZWxzZShNb2RhbGl0eSA9PSAiVGFzdGUiLCAxLCAwKSwNCiAgICAgICAgICAgICAgICAgICAgICAgIE1vZDEwID0gaWZfZWxzZShNb2RhbGl0eSA9PSAiU21lbGwiLCAxLCAwKSwNCiAgICAgICAgICAgICAgICAgICAgICAgIE1vZGFsaXR5ID0gZmFjdG9yKE1vZGFsaXR5KSwNCiAgICAgICAgICAgICAgICAgICAgICAgIE1vZFJlID0gcmVsZXZlbChNb2RhbGl0eSwgcmVmID0gJ1Rhc3RlJykpDQpgYGANCg0KQW5kIG5vdyBmb3Igc29tZSBtb2RlbHMuLi4NCg0KYGBge3J9DQpjaGVtX21kbDAxIDwtIGxtKFZhbCB+IE1vZDAxLCBkYXRhID0gY2hlbSkNCmNoZW1fbWRsMTAgPC0gbG0oVmFsIH4gTW9kMTAsIGRhdGEgPSBjaGVtKQ0KY2hlbV9tZGxGYWMgPC0gbG0oVmFsIH4gTW9kYWxpdHksIGRhdGEgPSBjaGVtKQ0KY2hlbV9tZGxSZSA8LSBsbShWYWwgfiBNb2RSZSwgZGF0YSA9IGNoZW0pDQpgYGANCg0KVGFrZSBhIHBlZWsgYXQgdGhlIHN1bW1hcmllcyBhbmQgY29lZmZpY2llbnQgdmFsdWVzLi4uDQoNCmBgYHtyfQ0KI2ZpdCBzdW1tYXJ5DQpnbGFuY2UoY2hlbV9tZGwwMSkkci5zcXVhcmVkDQpnbGFuY2UoY2hlbV9tZGwxMCkkci5zcXVhcmVkDQpnbGFuY2UoY2hlbV9tZGxGYWMpJHIuc3F1YXJlZA0KZ2xhbmNlKGNoZW1fbWRsUmUpJHIuc3F1YXJlZA0KDQojY29lZmZpY2llbnRzDQp0aWR5KGNoZW1fbWRsMDEpJGVzdGltYXRlDQp0aWR5KGNoZW1fbWRsMTApJGVzdGltYXRlDQp0aWR5KGNoZW1fbWRsRmFjKSRlc3RpbWF0ZQ0KdGlkeShjaGVtX21kbFJlKSRlc3RpbWF0ZQ0KYGBgDQpOb3cgbGV0J3MgdHJ5IE1vZGFsaXR5IHdpdGggc3VtIGNvbnRyYXN0czoNCg0KYGBge3J9DQpjaGVtIDwtIG11dGF0ZShjaGVtLCBNb2RTdW0gPSBNb2RhbGl0eSkNCg0KY29udHJhc3RzKGNoZW0kTW9kU3VtKSA8LSBjb250ci5zdW0oMikNCg0KY2hlbV9tZGxTdW0gPC0gbG0oVmFsIH4gTW9kU3VtLCBkYXRhID0gY2hlbSkNCg0Kc3VtbWFyeShjaGVtX21kbFN1bSkNCmBgYA0KTm90ZSB0aGF0IFJeMiwgRi1zdGF0LCBldGMuIGFyZSB0aGUgc2FtZSBldmVuIHRob3VnaCBpbnRlcmNlcHQgYW5kIHNsb3BlIGRpZmZlci4NCg0KIyMgdC10ZXN0DQoNCmBgYHtyfQ0KdC50ZXN0KFZhbCB+IE1vZGFsaXR5LCBkYXRhID0gY2hlbSwgdmFyLmVxdWFsID0gVCkNCmBgYA0KU2FtZSBwLXZhbHVlIGFzIHJlZ3Jlc3Npb24gbW9kZWwhDQoNCiMgQSBwcmVkaWN0b3Igd2l0aCBtb3JlIHRoYW4gMiBjYXRlZ29yaWVzDQoNCk5vdyB3ZSdsbCB0YWtlIGEgbG9vayBhdCB0aGUgd2hvbGUgZGF0YXNldCwgd2hpY2ggaGFzIDUgY2F0ZWdvcmllcyBmb3Igc2Vuc2UgbW9kYWxpdGllcy4NCg0KYGBge3J9DQpzZW5zZV9hbGwgPC0gbG0oVmFsIH4gTW9kYWxpdHksIGRhdGEgPSBzZW5zZXMpDQoNCnN1bW1hcnkoc2Vuc2VfYWxsKQ0KYGBgDQojIyBUbyBjb21wYXJlOiBBTk9WQQ0KDQpOb3cgZm9yIHRoZSBBTk9WQSBhcHByb2FjaDoNCg0KYGBge3J9DQphb3Zfc2Vuc2VzIDwtIGFvdihWYWwgfiBNb2RhbGl0eSwgZGF0YSA9IHNlbnNlcykNCg0Kc3VtbWFyeShhb3Zfc2Vuc2VzKQ0KYGBgDQpTYW1lIG1vZGVsIGZpdCAtIEYtc3RhdCBhbmQgcC52YWwgYXJlIGlkZW50aWNhbC4NCg0KIyMgZ2V0dGluZyBhdCB0aGUgY29udHJhc3RzLi4uDQoNClRoZSBgZWFzeXN0YXRzYCBwYWNrYWdlIGluY2x1ZGVzIHRoZSBgbW9kZWxiYXNlZGAgcGFja2FnZSwgd2hpY2ggaXMgaGVscGZ1bCBmb3IgZXh0cmFjdGluZyBtb2RlbCBjb250cmFzdHMgb2YgaW50ZXJlc3Qgd2hlbiB3b3JraW5nIHdpdGggY2F0ZWdvcmljYWwgdmFyaWFibGVzLiANCmBgYHtyfQ0KbGlicmFyeShlYXN5c3RhdHMpDQpgYGANCg0KV2UnbGwgZmlyc3QgdXNlIHRoZSBgZXN0aW1hdGVfbWVhbnMoKWAgZnVuY3Rpb24gdG8gZ2V0IHRoZSBtb2RlbC1iYXNlZCBlc3RpbWF0ZXMgZm9yIGVhY2ggY2F0ZWdvcnkuIFRoc2UgYXJlIHVzZWZ1bCB0byByZXBvcnQgYXMgZGVzY3JpcHRpdmUgc3RhdGlzdGljcywgb3IgZm9yIHBsb3R0aW5nLg0KDQpgYGB7cn0NCnNlbnNlX2FsbF9tZWFucyA8LSBlc3RpbWF0ZV9tZWFucyhzZW5zZV9hbGwsIGJ5ID0gIk1vZGFsaXR5IikNCg0Kc2Vuc2VfYWxsX21lYW5zDQpgYGANCmBgYHtyfQ0KcGxvdChzZW5zZV9hbGxfbWVhbnMpDQpgYGANCg0KDQpXZSBjYW4gdXNlIHRoZSBgZXN0aW1hdGVfY29udHJhc3RzKClgIGZ1bmN0aW9uIHRvIGV4YW1pbmUgcGFpcndpc2UgZGlmZmVyZW5jZXMgYW1vbmcgY2F0ZWdvcmlhbCB2YXJpYWJsZXMuDQoNCmBgYHtyfQ0Kc2Vuc2VfYWxsX2NvbnRyYXN0cyA8LSBlc3RpbWF0ZV9jb250cmFzdHMoc2Vuc2VfYWxsLCBjb250cmFzdCA9ICJNb2RhbGl0eSIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBwX2FkanVzdCA9ICJ0dWtleSIpDQoNCnNlbnNlX2FsbF9jb250cmFzdHMNCmBgYA0KDQpZb3UgY2FuIGRvIHRoZSBzYW1lIHRoaW5nIHdpdGggdGhlIEFOT1ZBIG1vZGVsLCB0b28h