CERT Eye-Tracking Publication
Allison Londerée
May 3, 2017
Some Set Up
First let me outline the location of all files involved in the analysis.
- Demographic Information - “C:/Users/londeree.4/Dropbox/Lab-Londeree/osu-certs-pilot/experiment-surveys/Demographics/demographics.csv”
- Eye-Tracking Trial-by-Trail AIO Data “C:/Users/londeree.4/Dropbox/Lab-Londeree/osu-certs-pilot/experiment-eyetracking/mlm/AOI Reports/ViewingPeriodAOIReportAD.csv” and “C:/Users/londeree.4/Dropbox/Lab-Londeree/osu-certs-pilot/experiment-eyetracking/mlm/AOI Reports/ViewingPeriodAOIReportIMAGE.csv”
- Rating Data - “C:/Users/londeree.4/Dropbox/Lab-Londeree/osu-certs-pilot/experiment-surveys/Ratings/AggTrialAdRatings.csv”
- Survey Data - “C:/Users/londeree.4/Dropbox/Lab-Londeree/osu-certs-pilot/experiment-surveys/Survey/SPSSSurveys.sav
Demographics
I won’t be analyzing the demographic data, I’ve included just a few discriptive statistics. Additoinally, smoking status will be used to subset analyses later on.
library(Hmisc)
demographics = read.csv("C:/Users/londeree.4/Dropbox/Lab-Londeree/osu-certs-pilot/experiment-surveys/Demographics/demographics.csv", stringsAsFactors = FALSE)
describe(demographics)## demographics
##
## 13 Variables 46 Observations
## ---------------------------------------------------------------------------
## StudyID
## n missing distinct
## 46 0 46
##
## lowest : CERT001 CERT002 CERT003 CERT004 CERT005
## highest: CERT042 CERT043 CERT044 CERT045 CERT046
## ---------------------------------------------------------------------------
## Age
## n missing distinct Info Mean Gmd
## 46 0 3 0.86 17.24 0.8242
##
## Value 16 17 18
## Frequency 9 17 20
## Proportion 0.196 0.370 0.435
## ---------------------------------------------------------------------------
## Race
## n missing distinct
## 46 0 10
##
## African American (6, 0.130), Asian (2, 0.043), Black and White (1, 0.022),
## Caucasian (31, 0.674), Don't Know (1, 0.022), Half black, half Asian (1,
## 0.022), hispanic and european and native american indian (1, 0.022),
## Middle eastern, Arab (1, 0.022), Pacific Islander (1, 0.022), White and
## Asian (1, 0.022)
## ---------------------------------------------------------------------------
## Ethnicity
## n missing distinct
## 46 0 3
##
## Value Non-hispanic Other Unknown
## Frequency 42 3 1
## Proportion 0.913 0.065 0.022
## ---------------------------------------------------------------------------
## Sex
## n missing distinct
## 46 0 2
##
## Value F M
## Frequency 26 20
## Proportion 0.565 0.435
## ---------------------------------------------------------------------------
## Height
## n missing distinct Info Mean Gmd .05 .10
## 46 0 15 0.985 66.18 4.065 62.25 63.00
## .25 .50 .75 .90 .95
## 64.00 65.00 68.75 72.50 73.00
##
## Value 59.5 60.0 62.0 63.0 64.0 65.0 66.0 67.0 68.0 69.0
## Frequency 1 1 1 8 8 6 4 4 1 3
## Proportion 0.022 0.022 0.022 0.174 0.174 0.130 0.087 0.087 0.022 0.065
##
## Value 70.0 71.0 72.0 73.0 74.0
## Frequency 1 2 1 4 1
## Proportion 0.022 0.043 0.022 0.087 0.022
## ---------------------------------------------------------------------------
## Weight
## n missing distinct Info Mean Gmd .05 .10
## 46 0 26 0.997 145.2 30.55 112.2 115.0
## .25 .50 .75 .90 .95
## 126.6 139.0 159.8 175.0 180.0
##
## lowest : 105.00 111.20 115.00 116.00 120.00, highest: 165.00 170.00 180.00 244.38 250.00
## ---------------------------------------------------------------------------
## BMI
## n missing distinct Info Mean Gmd .05 .10
## 46 0 43 1 23.3 4.328 18.86 19.10
## .25 .50 .75 .90 .95
## 20.48 22.23 24.58 27.45 30.89
##
## lowest : 18.59788 18.82662 18.96608 19.00411 19.19555
## highest: 27.43572 27.45444 30.89355 32.97992 41.94315
## ---------------------------------------------------------------------------
## Edu
## n missing distinct
## 46 0 5
##
## Value 10th Grade 11th Grade 12th Grade
## Frequency 2 10 14
## Proportion 0.043 0.217 0.304
##
## Value Currently in College Graduated HS
## Frequency 10 10
## Proportion 0.217 0.217
## ---------------------------------------------------------------------------
## EduNum
## n missing distinct Info Mean Gmd
## 46 0 5 0.941 2.348 1.329
##
## Value 0 1 2 3 4
## Frequency 2 10 14 10 10
## Proportion 0.043 0.217 0.304 0.217 0.217
## ---------------------------------------------------------------------------
## EcigUse
## n missing distinct
## 46 0 2
##
## Value No Yes
## Frequency 35 11
## Proportion 0.761 0.239
## ---------------------------------------------------------------------------
## CigUse
## n missing distinct
## 46 0 2
##
## Value No Yes
## Frequency 38 8
## Proportion 0.826 0.174
## ---------------------------------------------------------------------------
## AnyUse
## n missing distinct
## 46 0 2
##
## Value No Yes
## Frequency 34 12
## Proportion 0.739 0.261
## ---------------------------------------------------------------------------Eye Tracking Analysis
Import and Cleaning
First Let’s load in the data we need. The following datasets are raw from the eyelink software. This data is in “long” format- each row is an individual trial from a subject, each column is a varible of interest. This leads to a total of 1288 rows with 125 variables.
rawDataAD is a set of data on the ads of interest for each subject in this dataset across both versions of the task. rawDataIMAGE is a set of data on the entire scene for each subject. We won’t need to use this much - it will just be to correct a few measures.
#load specific CSV file of raw data
rawDataAD = read.csv("C:/Users/londeree.4/Dropbox/Lab-Londeree/osu-certs-pilot/experiment-eyetracking/mlm/AOI Reports/ViewingPeriodAOIReportAD.csv", stringsAsFactors = FALSE)
rawDataIMAGE = read.csv("C:/Users/londeree.4/Dropbox/Lab-Londeree/osu-certs-pilot/experiment-eyetracking/mlm/AOI Reports/ViewingPeriodAOIReportIMAGE.csv")Now, let’s clean this up. We don’t need all 125 variables for this analysis. While we are at it, let’s also correct for individuals who did not follow the task instructions. Anything that we would like to put into our model that is a factor, we should also specify
#create a corrected dwell time percent variable.
rawDataAD$IA_DWELL_TIME_PERCORRECTED <- (rawDataAD$IA_DWELL_TIME / rawDataIMAGE$IA_DWELL_TIME)
#load in some packages to tidy the data
require(dplyr)
require(tidyr)
#Select columns of interest and save to a new data frame
DataAD <- data.frame(rawDataAD[c('SUBID', 'counterbalanceversion', 'imagetype', 'scene', 'ad', 'IA_AREA', 'IA_DWELL_TIME_PERCORRECTED', 'IA_FIRST_FIXATION_DURATION', 'IA_FIRST_FIXATION_INDEX', 'IA_FIXATION_COUNT', 'IA_FIRST_FIXATION_TIME', 'IA_FIRST_RUN_DWELL_TIME')])
#Specify variables that should be factors
DataAD$facimagetype <- as.factor(DataAD$imagetype)
DataAD$ad<-as.factor(DataAD$ad)
DataAD$scene<-as.factor(DataAD$scene)
DataAD$counterbalanceversion<-as.factor(DataAD$counterbalanceversion)
DataAD$numimagetype <- as.numeric(factor(DataAD$imagetype))
#Examine the new dataset
str(DataAD)## 'data.frame': 1288 obs. of 14 variables:
## $ SUBID : int 1 1 1 1 1 1 1 1 1 1 ...
## $ counterbalanceversion : Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...
## $ imagetype : chr "TAT" "FAT" "TAT" "TAT" ...
## $ scene : Factor w/ 28 levels "1","2","3","4",..: 10 11 12 13 14 15 16 17 18 19 ...
## $ ad : Factor w/ 28 levels "1","2","3","4",..: 10 11 12 13 14 15 16 17 18 19 ...
## $ IA_AREA : num 10450 26702 25564 4158 4020 ...
## $ IA_DWELL_TIME_PERCORRECTED: num 0.0439 0.0973 0.1003 0 0 ...
## $ IA_FIRST_FIXATION_DURATION: int 237 158 175 NA NA 162 NA 57 236 213 ...
## $ IA_FIRST_FIXATION_INDEX : int 25 6 2 NA NA 2 NA 21 1 3 ...
## $ IA_FIXATION_COUNT : int 1 3 3 0 0 4 0 3 2 7 ...
## $ IA_FIRST_FIXATION_TIME : int 7526 3108 2265 NA NA 2279 NA 7363 2036 2467 ...
## $ IA_FIRST_RUN_DWELL_TIME : int 237 158 546 NA NA 162 NA 610 236 1444 ...
## $ facimagetype : Factor w/ 2 levels "FAT","TAT": 2 1 2 2 1 1 2 1 2 1 ...
## $ numimagetype : num 2 1 2 2 1 1 2 1 2 1 ...summary(DataAD)## SUBID counterbalanceversion imagetype scene
## Min. : 1.0 1:644 Length:1288 1 : 46
## 1st Qu.:12.0 2:644 Class :character 2 : 46
## Median :23.5 Mode :character 3 : 46
## Mean :23.5 4 : 46
## 3rd Qu.:35.0 5 : 46
## Max. :46.0 6 : 46
## (Other):1012
## ad IA_AREA IA_DWELL_TIME_PERCORRECTED
## 1 : 46 Min. : 4020 Min. :0.00000
## 2 : 46 1st Qu.: 8967 1st Qu.:0.03296
## 3 : 46 Median :11519 Median :0.10859
## 4 : 46 Mean :17542 Mean :0.14574
## 5 : 46 3rd Qu.:22314 3rd Qu.:0.20645
## 6 : 46 Max. :78542 Max. :1.00000
## (Other):1012
## IA_FIRST_FIXATION_DURATION IA_FIRST_FIXATION_INDEX IA_FIXATION_COUNT
## Min. : 20.0 Min. : 1.000 Min. : 0.00
## 1st Qu.: 166.0 1st Qu.: 3.000 1st Qu.: 1.00
## Median : 210.0 Median : 7.000 Median : 2.00
## Mean : 238.2 Mean : 8.457 Mean : 3.05
## 3rd Qu.: 259.2 3rd Qu.:13.000 3rd Qu.: 4.00
## Max. :2700.0 Max. :28.000 Max. :22.00
## NA's :284 NA's :284
## IA_FIRST_FIXATION_TIME IA_FIRST_RUN_DWELL_TIME facimagetype numimagetype
## Min. :2031 Min. : 33.0 FAT:644 Min. :1.0
## 1st Qu.:2484 1st Qu.: 243.0 TAT:644 1st Qu.:1.0
## Median :3600 Median : 449.5 Median :1.5
## Mean :3943 Mean : 640.3 Mean :1.5
## 3rd Qu.:5120 3rd Qu.: 809.2 3rd Qu.:2.0
## Max. :8002 Max. :5948.0 Max. :2.0
## NA's :284 NA's :284Examining a Simple Relationship
Let’s look at a TTest analysis of these differences
library(ggplot2)
t.test(DataAD$IA_DWELL_TIME_PERCORRECTED~DataAD$numimagetype)##
## Welch Two Sample t-test
##
## data: DataAD$IA_DWELL_TIME_PERCORRECTED by DataAD$numimagetype
## t = 6.4283, df = 1202.7, p-value = 1.856e-10
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.03696481 0.06943976
## sample estimates:
## mean in group 1 mean in group 2
## 0.1723435 0.1191413qplot(factor(numimagetype),IA_DWELL_TIME_PERCORRECTED, data= DataAD, geom = c("boxplot"))
t.test(DataAD$IA_FIXATION_COUNT~DataAD$numimagetype)##
## Welch Two Sample t-test
##
## data: DataAD$IA_FIXATION_COUNT by DataAD$numimagetype
## t = 5.5351, df = 1204, p-value = 3.816e-08
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.6084549 1.2766382
## sample estimates:
## mean in group 1 mean in group 2
## 3.521739 2.579193qplot(factor(numimagetype),IA_FIXATION_COUNT, data= DataAD, geom = c("boxplot"))
t.test(DataAD$IA_FIRST_FIXATION_TIME~DataAD$numimagetype)##
## Welch Two Sample t-test
##
## data: DataAD$IA_FIRST_FIXATION_TIME by DataAD$numimagetype
## t = 1.0908, df = 997.06, p-value = 0.2756
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -88.39133 309.63482
## sample estimates:
## mean in group 1 mean in group 2
## 3995.933 3885.311qplot(factor(numimagetype),IA_FIRST_FIXATION_TIME, data= DataAD, geom = c("boxplot"))## Warning: Removed 284 rows containing non-finite values (stat_boxplot).
OK, so it looks like we have a significant effect of both % dwell time and fixation count. First fixation time is non-significant but it looks like it’s in the right direction.
Note that these the first fixation time has 284 NA values for trials that were never fixated on. Consider adding this into the model?
Correlation between outcome variables
Let’s notice the relationship between fixation count and dwell time
cor.test(DataAD$IA_DWELL_TIME_PERCORRECTED,DataAD$IA_FIXATION_COUNT)##
## Pearson's product-moment correlation
##
## data: DataAD$IA_DWELL_TIME_PERCORRECTED and DataAD$IA_FIXATION_COUNT
## t = 77.06, df = 1286, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.8964064 0.9159007
## sample estimates:
## cor
## 0.9066363r <- round(cor(DataAD$IA_DWELL_TIME_PERCORRECTED,DataAD$IA_FIXATION_COUNT), 4)
r<- paste('r =',r)
p <- round(cor.test(DataAD$IA_DWELL_TIME_PERCORRECTED,DataAD$IA_FIXATION_COUNT)$p.value, 4)
p <- paste('p =',p)
qplot(IA_DWELL_TIME_PERCORRECTED, IA_FIXATION_COUNT, data = DataAD, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', .5,16,label= r)+annotate('text', .5,18,label= p)
They are very correlated! This is unsurprising but may be relevant to inlcuding one over the other.
Judd, Westfall and Kenny Approach using Lme4
First, let’s quickly load in the lme4 package and a few others.
pbkrtest is Parametric Bootstrap and Kenward Roger Based Methods for Mixed Model Comparison.
lmerTest performs different types of tests on lmer objects. Here I use it to display the P values for the tests we use.
arm provides functions to accompany A. Gelman and J. Hill, Data Analysis Using Regression and Multilevel/Hierarchical Models, Cambridge University Press, 2007
AICcmodavg gives more functions to implement model selection and multimodel inference based on Akaike’s information criterion.
lattice and ggplot2 are graphing functions.
library(lme4)
library(multilevel)
library(pbkrtest)
library(lmerTest)
library(ggplot2)
library(arm)
library(AICcmodavg)
library(lattice)Step 1 - Know your data
Why should we even use MLM for this data set?
# Used to strip down figures to make them simpler
fig <- theme_bw() + theme(panel.grid.minor=element_blank(), panel.grid.major=element_blank(), panel.background=element_blank()) +
theme(strip.background=element_blank(), strip.text.y = element_text()) + theme(legend.background=element_blank()) +
theme(legend.key=element_blank()) + theme(panel.border = element_rect(colour="black", fill=NA))
####Dwell Time Percent######
# Make the followoing three plots to explore the data
DTplot <- ggplot(aes(IA_DWELL_TIME_PERCORRECTED,imagetype),data=DataAD) + stat_sum(aes(size = ..n.., group = 1)) +
scale_size_area(max_size=5)
# Plot 1 - All Data
DTplot + geom_point() + xlab("Dwell Time %") + ylab("Image Type") + labs(title="All Data") + fig 
# Plot 1 - All Data
xyplot(IA_DWELL_TIME_PERCORRECTED~facimagetype,data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Dwell Time")
# Plot 2 - By Counterbalance Version
xyplot(IA_DWELL_TIME_PERCORRECTED~facimagetype|as.factor(counterbalanceversion),data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Dwell Time")
# Plot 3 - By Subject
xyplot(IA_DWELL_TIME_PERCORRECTED~facimagetype|as.factor(SUBID),data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Dwell Time")
# Plot 4 - By Scene
xyplot(IA_DWELL_TIME_PERCORRECTED~facimagetype|as.factor(scene),data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Dwell Time")
# Plot 5 - By Ad - UHOH!
xyplot(IA_DWELL_TIME_PERCORRECTED~facimagetype|as.factor(ad),data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Dwell Time")
####Fixation Count#####
# Make the followoing three plots to explore the data
FCplot <- ggplot(aes(IA_FIXATION_COUNT,imagetype),data=DataAD) + stat_sum(aes(size = ..n.., group = 1)) +
scale_size_area(max_size=5)
# Plot 1 - All Data
FCplot + geom_point() + xlab("Fixation Count") + ylab("Image Type") + labs(title="All Data") + fig 
# Plot 1 - All Data
xyplot(IA_FIXATION_COUNT~facimagetype,data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Fixation Count")
# Plot 2 - By Counterbalance Version
xyplot(IA_FIXATION_COUNT~facimagetype|as.factor(counterbalanceversion),data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Fixation Count")
# Plot 3 - By Subject
xyplot(IA_FIXATION_COUNT~facimagetype|as.factor(SUBID),data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Fixation Count")
# Plot 4 - By Scene
xyplot(IA_FIXATION_COUNT~facimagetype|as.factor(scene),data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Fixation Count")
####Time to First Fixation#####
# Make the followoing three plots to explore the data
FTplot <- ggplot(aes(IA_FIRST_FIXATION_TIME,imagetype),data=DataAD) + stat_sum(aes(size = ..n.., group = 1)) +
scale_size_area(max_size=5)
# Plot 1 - All Data
FTplot + geom_point() + xlab("Time to First Fixation") + ylab("Image Type") + labs(title="All Data") + fig ## Warning: Removed 284 rows containing non-finite values (stat_sum).## Warning: Removed 284 rows containing missing values (geom_point).
# Plot 1 - All Data
xyplot(IA_FIRST_FIXATION_TIME~facimagetype,data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Time to First Fixation")
# Plot 2 - By Counterbalance Version
xyplot(IA_FIRST_FIXATION_TIME~facimagetype|as.factor(counterbalanceversion),data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Time to First Fixation")
# Plot 3 - By Subject
xyplot(IA_FIRST_FIXATION_TIME~facimagetype|as.factor(SUBID),data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Time to First Fixation")
# Plot 4 - By Scene
xyplot(IA_FIRST_FIXATION_TIME~facimagetype|as.factor(scene),data=DataAD[1:1582,], type=c("p","g","r"),col="dark blue",col.line="black", xlab="Image Type", ylab="Time to First Fixation")
Step 2 - Examine the ICC(1) for the Outcome
Because multilevel modeling involves predicting variance at different levels, it is important to begin analyses by determining the levels at which significant variation exists.
We first examine the group-level properties of the outcome variable to estimate the ICC(1). Second, we determine whether the variance of the intercept (t00) is significantly larger than zero. ###Calculating ICC(1)
Null.Model1<-lme(IA_DWELL_TIME_PERCORRECTED~1,random=~1|scene,data=DataAD,
control=list(opt="optim"))
VarCorr(Null.Model1)## scene = pdLogChol(1)
## Variance StdDev
## (Intercept) 0.006544322 0.08089698
## Residual 0.016431308 0.12818466 Null.Model2<-lme(IA_FIXATION_COUNT~1,random=~1|scene,data=DataAD,
control=list(opt="optim"))
VarCorr(Null.Model2)## scene = pdLogChol(1)
## Variance StdDev
## (Intercept) 3.424397 1.850513
## Residual 6.247567 2.499513 #Null.Model3<-lme(IA_FIRST_FIXATION_TIME~1,random=~1|scene,data=DataAD,control=list(opt="optim"), na.omit)
#VarCorr(Null.Model3)The estimate of t00 (between-group or Intercept variance) is 0.006, and the estimate of sigma^2 (within-group or residual variancel) is 0.0164.
Now from this information we can calculate ICC by hand
DTICC <- 0.006544322/(0.006544322+0.016431308)
FCICC <- 3.424397/ (3.424397+6.247567)The ICC estimate (t00/(t00+sigma^2)) is .2848
To verify that the ICC results from the mixed-effects models are similar to those from an ANOVA model and the ICC1 function we can perform an ANOVA analysis on the same data.
tmod1<-aov(IA_DWELL_TIME_PERCORRECTED~as.factor(scene),data=DataAD)
ICC1(tmod1)## [1] 0.2848375tmod2<-aov(IA_FIXATION_COUNT~as.factor(scene),data=DataAD)
ICC1(tmod2)## [1] 0.3540539These values are indeed close to the one in our model.
Determining t00’s significance
We would likely be interested in knowing whether the intercept variance (i.e.,t00) estimate of .0065 is significantly different from zero. In mixed-effects models, we perform this test by comparing -2 log likelihood values between (1) a model with a random intercept, and (2) a model without a random intercept.
Null.gls1<-gls(IA_DWELL_TIME_PERCORRECTED~1,data=DataAD,
control=list(opt="optim"))
logLik(Null.gls1)*-2## 'log Lik.' -1209.638 (df=2)logLik(Null.Model1)*-2## 'log Lik.' -1548.265 (df=3)-1209.638--1548.265## [1] 338.627anova(Null.gls1, Null.Model1)## Model df AIC BIC logLik Test L.Ratio p-value
## Null.gls1 1 2 -1205.638 -1195.318 604.8189
## Null.Model1 2 3 -1542.264 -1526.784 774.1323 1 vs 2 338.6268 <.0001Null.gls2<-gls(IA_FIXATION_COUNT~1,data=DataAD,
control=list(opt="optim"))
logLik(Null.gls2)*-2## 'log Lik.' 6563.978 (df=2)logLik(Null.Model2)*-2## 'log Lik.' 6105.729 (df=3)-1209.638--1548.265## [1] 338.627anova(Null.gls2, Null.Model2)## Model df AIC BIC logLik Test L.Ratio p-value
## Null.gls2 1 2 6567.978 6578.298 -3281.989
## Null.Model2 2 3 6111.729 6127.209 -3052.865 1 vs 2 458.2483 <.0001The -2 log likelihood value for the gls model without the random intercept is -1209.638. The -2 log likelihood value for the model with the random intercept is -1548.265 The difference of 338.627 is significant on a Chi-Squared distribution with one degree of freedom (one model estimated a variance term associated with a random intercept, the other did not, and this results in the one df difference). These results indicate significant intercept variation.
Step 3 - Examine and Model Intercept Variance and Slope Variance
Now that we have examined within group variance, let’s try and model various intercept and slope models to capture between-group variance
# List of all Potential models-->
# Note: you can chose to not code ones that do not make sense.
# Linear model with no random effects
DTM0<-lm(IA_DWELL_TIME_PERCORRECTED~imagetype,data=DataAD)
#What about just using counterbalance to combine across ad and scene?
DTM1<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1|counterbalanceversion) + (1|SUBID), data=DataAD, REML=FALSE)
DTM2<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1+imagetype|counterbalanceversion) + (1|SUBID), data=DataAD, REML=FALSE)
DTM3<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1|counterbalanceversion) + (1+imagetype|SUBID), data=DataAD, REML=FALSE)
DTM4<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1+imagetype|counterbalanceversion) + (1+imagetype|SUBID), data=DataAD, REML=FALSE)
# Full model with varying intercepts
DTM5<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1|scene) + (1|ad) + (1|SUBID), data=DataAD, REML=FALSE)
# Full model with varying intercepts and slopes (This is no good!)
# No Scene, varying intercepts only
DTM6<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1|ad) + (1|SUBID), data=DataAD, REML=FALSE)
# No Ad, varying intercepts only
DTM7<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1|scene) + (1|SUBID), data=DataAD, REML=FALSE)
# No Subjects, varying intercepts only
DTM8<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1|scene) + (1|ad), data=DataAD, REML=FALSE)
# No Ad, varying intercepts and slopes
DTM9<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1+imagetype|scene) + (1+imagetype|SUBID), data=DataAD, REML=FALSE)
# Full model with varying intercepts and slopes only varying by scene
DTM10<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1+imagetype|scene) + (1|ad) + (1|SUBID), data=DataAD, REML=FALSE)
# Full model with varying intercepts and slopes only varying by subject
DTM11<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1|scene) + (1|ad) + (1+imagetype|SUBID), data=DataAD, REML=FALSE)
# Full model with varying intercepts and slopes only varying by scene and subject
DTM12<-lmer(IA_DWELL_TIME_PERCORRECTED~imagetype + (1+imagetype|scene) + (1|ad) + (1+imagetype|SUBID), data=DataAD, REML=FALSE)
# ii) Compare models using AICc values
# Compute AICc values for each model
AICc<-c(AICc(DTM0), AICc(DTM1), AICc(DTM2), AICc(DTM3), AICc(DTM4), AICc(DTM5), AICc(DTM6), AICc(DTM7), AICc(DTM8), AICc(DTM9), AICc(DTM10), AICc(DTM11), AICc(DTM12))
# Put values into one table for easy comparision
Model<-c("M0", "M1", "M2", "M3", "M4", "M5", "M6", "M7", "M8", "M9", "M10", "M11", "M12")
AICtable<-data.frame(DTModel=Model, DTAICc=AICc)
AICtable## DTModel DTAICc
## 1 M0 -1253.462
## 2 M1 -1256.265
## 3 M2 -1252.224
## 4 M3 -1256.260
## 5 M4 -1252.207
## 6 M5 -1688.260
## 7 M6 -1659.597
## 8 M7 -1624.803
## 9 M8 -1662.352
## 10 M9 -1682.577
## 11 M10 -1688.232
## 12 M11 -1693.532
## 13 M12 -1693.684#Let's do the same for number of fixations
# Linear model with no random effects
FCM0<-lm(IA_FIXATION_COUNT~imagetype,data=DataAD)
#What about just using counterbalance to combine across ad and scene?
FCM1<-lmer(IA_FIXATION_COUNT~imagetype + (1|counterbalanceversion) + (1|SUBID), data=DataAD, REML=FALSE)
FCM2<-lmer(IA_FIXATION_COUNT~imagetype + (1+imagetype|counterbalanceversion) + (1|SUBID), data=DataAD, REML=FALSE)
FCM3<-lmer(IA_FIXATION_COUNT~imagetype + (1|counterbalanceversion) + (1+imagetype|SUBID), data=DataAD, REML=FALSE)
FCM4<-lmer(IA_FIXATION_COUNT~imagetype + (1+imagetype|counterbalanceversion) + (1+imagetype|SUBID), data=DataAD, REML=FALSE)
# Full model with varying intercepts
FCM5<-lmer(IA_FIXATION_COUNT~imagetype + (1|scene) + (1|ad) + (1|SUBID), data=DataAD, REML=FALSE)
# Full model with varying intercepts and slopes (This is no good!)
# No Scene, varying intercepts only
FCM6<-lmer(IA_FIXATION_COUNT~imagetype + (1|ad) + (1|SUBID), data=DataAD, REML=FALSE)
# No Ad, varying intercepts only
FCM7<-lmer(IA_FIXATION_COUNT~imagetype + (1|scene) + (1|SUBID), data=DataAD, REML=FALSE)
# No Subjects, varying intercepts only
FCM8<-lmer(IA_FIXATION_COUNT~imagetype + (1|scene) + (1|ad), data=DataAD, REML=FALSE)
# No Ad, varying intercepts and slopes
FCM9<-lmer(IA_FIXATION_COUNT~imagetype + (1+imagetype|scene) + (1+imagetype|SUBID), data=DataAD, REML=FALSE)
# Full model with varying intercepts and slopes only varying by scene
FCM10<-lmer(IA_FIXATION_COUNT~imagetype + (1+imagetype|scene) + (1|ad) + (1|SUBID), data=DataAD, REML=FALSE)
# Full model with varying intercepts and slopes only varying by subject
FCM11<-lmer(IA_FIXATION_COUNT~imagetype + (1|scene) + (1|ad) + (1+imagetype|SUBID), data=DataAD, REML=FALSE)
# Full model with varying intercepts and slopes only varying by scene and subject
FCM12<-lmer(IA_FIXATION_COUNT~imagetype + (1+imagetype|scene) + (1|ad) + (1+imagetype|SUBID), data=DataAD, REML=FALSE)
# ii) Compare models using AICc values
# Compute AICc values for each model
AICc<-c(AICc(FCM0), AICc(FCM1), AICc(FCM2), AICc(FCM3), AICc(FCM4), AICc(FCM5), AICc(FCM6), AICc(FCM7), AICc(FCM8), AICc(FCM9), AICc(FCM10), AICc(FCM11), AICc(FCM12))
# Put values into one table for easy comparision
Model<-c("M0", "M1", "M2", "M3", "M4", "M5", "M6", "M7", "M8", "M9", "M10", "M11", "M12")
AICtable<-data.frame(FCModel=Model, FCAICc=AICc)
AICtable## FCModel FCAICc
## 1 M0 6536.605
## 2 M1 6526.697
## 3 M2 6530.737
## 4 M3 6525.474
## 5 M4 6529.528
## 6 M5 5968.641
## 7 M6 5999.051
## 8 M7 6021.585
## 9 M8 6020.087
## 10 M9 5973.010
## 11 M10 5970.849
## 12 M11 5960.299
## 13 M12 5962.057After more thought, counterbalance version may be the best fit for our model rather than modeling ad and scene type separately. DTM1 and DTM3 are really close to the lowest AICc value so these have the best model fit. FCM1 and FCM3 are also good fits for fixation count. Let’s look at them in more detail!
Note when you compare models they must be fit by Maximum Likelihood (ML) and not by Restricted Maximum Likelihood (REML). You may also want to compare BIC values for your models
Step 4 - Model Validation
Wonderful! Now we have found some well-fitting models lets take a peek at independence plot model fitted values vs residuals values:
E1 <- resid(DTM1)
F1<-fitted(DTM1)
plot(x = F1,
y = E1,
xlab = "Fitted Values DTM1",
ylab = "Normalized residuals DTM1")
abline(h = 0, lty = 2)
E1 <- resid(DTM3)
F1<-fitted(DTM3)
plot(x = F1,
y = E1,
xlab = "Fitted Values DTM3",
ylab = "Normalized residuals DTM3")
abline(h = 0, lty = 2)
E1 <- resid(FCM1)
F1<-fitted(FCM1 )
plot(x = F1,
y = E1,
xlab = "Fitted Values FCM1",
ylab = "Normalized residuals FCM1")
abline(h = 0, lty = 2)
E1 <- resid(FCM3)
F1<-fitted(FCM3)
plot(x = F1,
y = E1,
xlab = "Fitted Values FCM3",
ylab = "Normalized residuals FCM3")
abline(h = 0, lty = 2)
Notice that the Fixation count data is a bit striated, this is due to the fact that all values must be intergers.
Also notice that all graphs have heteroskedasticity issues due to a floor effect in the data.
To check the assumption of homogeneity let’s plot residuals vs each covariate in the model.
plot(x = DataAD$facimagetype,
y = E1,
xlab = "Image Type",
ylab = "Normalized residuals")
abline(h = 0, lty = 2)
# Counterbalance
boxplot(E1 ~ counterbalanceversion,
ylab = "Normalized residuals",
data = DataAD, xlab = "Scene")
abline(h = 0, lty = 2)
#Subject
boxplot(E1 ~ SUBID,
ylab = "Normalized residuals",
data = DataAD, xlab = "SUBID")
abline(h = 0, lty = 2)
These don’t look so bad, even though the floor effect is there.
It is also important to check the distribution of residual error. Normally distributed residuals indicate that your model predictions are not biased high or low:
hist(E1)
Perhaps we can do something to combat this, but perhaps not. Regardless lets look at the results of each model.
Step 5 - Model Interpretation
summary(DTM1)## Linear mixed model fit by maximum likelihood t-tests use Satterthwaite
## approximations to degrees of freedom [lmerMod]
## Formula:
## IA_DWELL_TIME_PERCORRECTED ~ imagetype + (1 | counterbalanceversion) +
## (1 | SUBID)
## Data: DataAD
##
## AIC BIC logLik deviance df.resid
## -1256.3 -1230.5 633.2 -1266.3 1283
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.3628 -0.7127 -0.1974 0.4037 5.9344
##
## Random effects:
## Groups Name Variance Std.Dev.
## SUBID (Intercept) 0.0005131 0.02265
## counterbalanceversion (Intercept) 0.0000000 0.00000
## Residual 0.0215085 0.14666
## Number of obs: 1288, groups: SUBID, 46; counterbalanceversion, 2
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 1.723e-01 6.675e-03 1.161e+02 25.82 < 2e-16 ***
## imagetypeTAT -5.320e-02 8.173e-03 1.242e+03 -6.51 1.09e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## imagetypTAT -0.612summary(DTM3)## Linear mixed model fit by maximum likelihood t-tests use Satterthwaite
## approximations to degrees of freedom [lmerMod]
## Formula:
## IA_DWELL_TIME_PERCORRECTED ~ imagetype + (1 | counterbalanceversion) +
## (1 + imagetype | SUBID)
## Data: DataAD
##
## AIC BIC logLik deviance df.resid
## -1256.3 -1220.2 635.2 -1270.3 1281
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.5752 -0.7438 -0.2001 0.4141 6.0236
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## SUBID (Intercept) 0.0011623 0.03409
## imagetypeTAT 0.0004226 0.02056 -1.00
## counterbalanceversion (Intercept) 0.0000000 0.00000
## Residual 0.0213487 0.14611
## Number of obs: 1288, groups: SUBID, 46; counterbalanceversion, 2
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.172344 0.007643 48.450000 22.549 < 2e-16 ***
## imagetypeTAT -0.053202 0.008688 130.910000 -6.123 9.96e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## imagetypTAT -0.729summary(FCM1)## Linear mixed model fit by maximum likelihood t-tests use Satterthwaite
## approximations to degrees of freedom [lmerMod]
## Formula: IA_FIXATION_COUNT ~ imagetype + (1 | counterbalanceversion) +
## (1 | SUBID)
## Data: DataAD
##
## AIC BIC logLik deviance df.resid
## 6526.6 6552.5 -3258.3 6516.6 1283
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.4800 -0.7081 -0.1685 0.4038 6.0075
##
## Random effects:
## Groups Name Variance Std.Dev.
## SUBID (Intercept) 0.3304 0.5748
## counterbalanceversion (Intercept) 0.0000 0.0000
## Residual 8.9923 2.9987
## Number of obs: 1288, groups: SUBID, 46; counterbalanceversion, 2
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.5217 0.1454 101.6000 24.22 < 2e-16 ***
## imagetypeTAT -0.9425 0.1671 1242.0000 -5.64 2.1e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## imagetypTAT -0.575summary(FCM3)## Linear mixed model fit by maximum likelihood t-tests use Satterthwaite
## approximations to degrees of freedom [lmerMod]
## Formula: IA_FIXATION_COUNT ~ imagetype + (1 | counterbalanceversion) +
## (1 + imagetype | SUBID)
## Data: DataAD
##
## AIC BIC logLik deviance df.resid
## 6525.4 6561.5 -3255.7 6511.4 1281
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.6992 -0.7477 -0.1789 0.4093 5.9824
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## SUBID (Intercept) 0.6604 0.8127
## imagetypeTAT 0.1891 0.4348 -1.00
## counterbalanceversion (Intercept) 0.0000 0.0000
## Residual 8.9211 2.9868
## Number of obs: 1288, groups: SUBID, 46; counterbalanceversion, 2
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 3.5217 0.1680 48.7800 20.968 < 2e-16 ***
## imagetypeTAT -0.9425 0.1784 143.4400 -5.284 4.6e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## imagetypTAT -0.719All models are significant so a determination of which ACC fit makes more sense should be used to determine final model results. My sugestion would be to allow both models to vary by slope and intercept by both predictors (model 3) or have just the intercepts vary in both predictors(model 1). This way we can say that theoretically the variance in subject and counterbalance is the same across models where they should not differ.
One last thing- let’s make a DF of the means per subject to use in the combined analysis later.
DTaggdata <-aggregate(DataAD$IA_DWELL_TIME_PERCORRECTED, by=list(DataAD$numimagetype,DataAD$SUBID),
FUN=mean, na.rm=TRUE)
print(DTaggdata)## Group.1 Group.2 x
## 1 1 1 0.12198413
## 2 2 1 0.08197171
## 3 1 2 0.14883077
## 4 2 2 0.08159989
## 5 1 3 0.23939642
## 6 2 3 0.10896748
## 7 1 4 0.08451985
## 8 2 4 0.08246171
## 9 1 5 0.18869858
## 10 2 5 0.14042786
## 11 1 6 0.10761006
## 12 2 6 0.09502446
## 13 1 7 0.29792520
## 14 2 7 0.20361659
## 15 1 8 0.20729742
## 16 2 8 0.12972673
## 17 1 9 0.14530253
## 18 2 9 0.19879541
## 19 1 10 0.21340089
## 20 2 10 0.18125713
## 21 1 11 0.14501741
## 22 2 11 0.10994640
## 23 1 12 0.23323606
## 24 2 12 0.11866725
## 25 1 13 0.11101421
## 26 2 13 0.06254076
## 27 1 14 0.17786531
## 28 2 14 0.11246920
## 29 1 15 0.31860680
## 30 2 15 0.11034648
## 31 1 16 0.16710946
## 32 2 16 0.14625539
## 33 1 17 0.21378201
## 34 2 17 0.10650205
## 35 1 18 0.12229575
## 36 2 18 0.10382075
## 37 1 19 0.15531267
## 38 2 19 0.11787954
## 39 1 20 0.10471750
## 40 2 20 0.10465575
## 41 1 21 0.20810748
## 42 2 21 0.11818911
## 43 1 22 0.23731551
## 44 2 22 0.18468002
## 45 1 23 0.18217361
## 46 2 23 0.11998902
## 47 1 24 0.16395596
## 48 2 24 0.13318788
## 49 1 25 0.16294718
## 50 2 25 0.11093522
## 51 1 26 0.13990615
## 52 2 26 0.06629538
## 53 1 27 0.13076341
## 54 2 27 0.08674490
## 55 1 28 0.23887032
## 56 2 28 0.11523520
## 57 1 29 0.19827336
## 58 2 29 0.12779866
## 59 1 30 0.15625231
## 60 2 30 0.10715036
## 61 1 31 0.12667263
## 62 2 31 0.09509631
## 63 1 32 0.10785662
## 64 2 32 0.11302180
## 65 1 33 0.24528166
## 66 2 33 0.12069256
## 67 1 34 0.18631178
## 68 2 34 0.09130775
## 69 1 35 0.16522266
## 70 2 35 0.16992282
## 71 1 36 0.12040043
## 72 2 36 0.12768641
## 73 1 37 0.16047409
## 74 2 37 0.08227407
## 75 1 38 0.19087823
## 76 2 38 0.16104197
## 77 1 39 0.17133867
## 78 2 39 0.09762460
## 79 1 40 0.22958294
## 80 2 40 0.10418866
## 81 1 41 0.08074497
## 82 2 41 0.12385691
## 83 1 42 0.17148354
## 84 2 42 0.15710486
## 85 1 43 0.14298332
## 86 2 43 0.07471174
## 87 1 44 0.17889840
## 88 2 44 0.08204926
## 89 1 45 0.15303607
## 90 2 45 0.12073845
## 91 1 46 0.17414837
## 92 2 46 0.19204107FCaggdata <-aggregate(DataAD$IA_FIXATION_COUNT, by=list(DataAD$numimagetype,DataAD$SUBID),
FUN=mean, na.rm=TRUE)
print(FCaggdata)## Group.1 Group.2 x
## 1 1 1 2.642857
## 2 2 1 1.785714
## 3 1 2 2.642857
## 4 2 2 1.857143
## 5 1 3 5.142857
## 6 2 3 2.785714
## 7 1 4 1.714286
## 8 2 4 2.142857
## 9 1 5 4.357143
## 10 2 5 3.142857
## 11 1 6 2.357143
## 12 2 6 1.928571
## 13 1 7 5.642857
## 14 2 7 3.928571
## 15 1 8 4.428571
## 16 2 8 2.714286
## 17 1 9 2.142857
## 18 2 9 3.000000
## 19 1 10 4.428571
## 20 2 10 3.714286
## 21 1 11 3.142857
## 22 2 11 2.857143
## 23 1 12 5.000000
## 24 2 12 2.500000
## 25 1 13 2.500000
## 26 2 13 1.285714
## 27 1 14 3.571429
## 28 2 14 2.000000
## 29 1 15 6.714286
## 30 2 15 3.000000
## 31 1 16 3.428571
## 32 2 16 2.857143
## 33 1 17 4.357143
## 34 2 17 2.571429
## 35 1 18 2.428571
## 36 2 18 2.214286
## 37 1 19 3.642857
## 38 2 19 2.428571
## 39 1 20 2.571429
## 40 2 20 2.571429
## 41 1 21 3.214286
## 42 2 21 1.928571
## 43 1 22 5.357143
## 44 2 22 3.785714
## 45 1 23 3.857143
## 46 2 23 2.928571
## 47 1 24 3.357143
## 48 2 24 2.500000
## 49 1 25 4.357143
## 50 2 25 3.642857
## 51 1 26 2.714286
## 52 2 26 1.500000
## 53 1 27 2.428571
## 54 2 27 1.928571
## 55 1 28 4.857143
## 56 2 28 2.571429
## 57 1 29 4.928571
## 58 2 29 3.785714
## 59 1 30 3.357143
## 60 2 30 2.357143
## 61 1 31 3.071429
## 62 2 31 2.642857
## 63 1 32 2.285714
## 64 2 32 2.357143
## 65 1 33 4.785714
## 66 2 33 3.071429
## 67 1 34 3.785714
## 68 2 34 1.785714
## 69 1 35 3.000000
## 70 2 35 3.500000
## 71 1 36 2.642857
## 72 2 36 3.000000
## 73 1 37 2.714286
## 74 2 37 1.500000
## 75 1 38 4.500000
## 76 2 38 4.071429
## 77 1 39 3.357143
## 78 2 39 1.928571
## 79 1 40 4.214286
## 80 2 40 2.714286
## 81 1 41 1.500000
## 82 2 41 1.714286
## 83 1 42 3.000000
## 84 2 42 2.571429
## 85 1 43 2.714286
## 86 2 43 1.928571
## 87 1 44 3.500000
## 88 2 44 1.857143
## 89 1 45 3.214286
## 90 2 45 2.500000
## 91 1 46 2.428571
## 92 2 46 3.285714library(dplyr)
library(tidyr)
DTAggDataFAT<-filter(DTaggdata, DTaggdata$Group.1 == 1)
DTAggDataTAT<-filter(DTaggdata, DTaggdata$Group.1 == 2)
FCAggDataFAT<-filter(FCaggdata, FCaggdata$Group.1 == 1)
FCAggDataTAT<-filter(FCaggdata, FCaggdata$Group.1 == 2)
allaggFAT <- full_join(DTAggDataFAT,FCAggDataFAT, by = "Group.2")
allaggTAT <- full_join(DTAggDataTAT,FCAggDataTAT, by = "Group.2")
allagg <- full_join(allaggFAT,allaggTAT, by = "Group.2")
library(data.table)## Warning: package 'data.table' was built under R version 3.2.5## -------------------------------------------------------------------------## data.table + dplyr code now lives in dtplyr.
## Please library(dtplyr)!## -------------------------------------------------------------------------##
## Attaching package: 'data.table'## The following objects are masked from 'package:dplyr':
##
## between, first, lastnames <- c("FAT", "SUBID",'DTFAT',"FAT","FCFAT","TAT","DTTAT","TAT","FCTAT")
setnames(allagg, names)
allagg <- subset(allagg, select = c("SUBID",'DTFAT',"FCFAT","DTTAT","FCTAT"))Behavioral Rating Analysis
Now lets take a peek at the behavioral ratings. These ratings were collected via qualtrics. There are 3 types of ratings per image type; willingness to consume product, liking of product, and liking of ad. Averages per subject were caluclated across each rating.
First let’s load in the data
## Warning: package 'memisc' was built under R version 3.2.5##
## Attaching package: 'memisc'## The following object is masked from 'package:Matrix':
##
## as.array## The following objects are masked from 'package:dplyr':
##
## collect, query, recode, rename## The following objects are masked from 'package:Hmisc':
##
## %nin%, html## The following objects are masked from 'package:stats':
##
## contr.sum, contr.treatment, contrasts## The following object is masked from 'package:base':
##
## as.arrayLet’s also add a column to indicate smoking behavior at session.
Examing distribution of each rating type
hist(RatingData$LikeAd.m.FAT)
hist(RatingData$LikeFood.m.FAT)
hist(RatingData$Consume.m.FAT)
hist(RatingData$LikeAd.m.TAT)
hist(RatingData$LikeFood.m.TAT)
hist(RatingData$Consume.m.TAT)
hist(RatingData$LikeAd.m.FOOD)
hist(RatingData$LikeFood.m.FOOD)
hist(RatingData$Consume.m.FOOD)
These histograms are expected. For all tat features involving flavor or consumtion, ratings are quite low!
Examing correlations between of each rating types
First let’s look at correlations between FAT ratings
cor.test(RatingData$LikeAd.m.FAT, RatingData$LikeFood.m.FAT)##
## Pearson's product-moment correlation
##
## data: RatingData$LikeAd.m.FAT and RatingData$LikeFood.m.FAT
## t = 3.555, df = 44, p-value = 0.0009176
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.2110127 0.6707000
## sample estimates:
## cor
## 0.4723747r <- round(cor(RatingData$LikeAd.m.FAT, RatingData$LikeFood.m.FAT), 4)
r<- paste('r =',r)
p <- round(cor.test(RatingData$LikeAd.m.FAT, RatingData$LikeFood.m.FAT)$p.value, 4)
p <- paste('p =',p)
qplot(LikeAd.m.FAT, LikeFood.m.FAT, data = RatingData, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 5,2,label= r)+annotate('text', 5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(RatingData$Consume.m.FAT, RatingData$LikeFood.m.FAT)##
## Pearson's product-moment correlation
##
## data: RatingData$Consume.m.FAT and RatingData$LikeFood.m.FAT
## t = 0.93396, df = 44, p-value = 0.3554
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.1572379 0.4130061
## sample estimates:
## cor
## 0.1394243r <- round(cor(RatingData$Consume.m.FAT, RatingData$LikeFood.m.FAT), 4)
r<- paste('r =',r)
p <- round(cor.test(RatingData$Consume.m.FAT, RatingData$LikeFood.m.FAT)$p.value, 4)
p <- paste('p =',p)
qplot(Consume.m.FAT, LikeFood.m.FAT, data = RatingData, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 5,2,label= r)+annotate('text', 5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(RatingData$Consume.m.FAT, RatingData$LikeAd.m.FAT)##
## Pearson's product-moment correlation
##
## data: RatingData$Consume.m.FAT and RatingData$LikeAd.m.FAT
## t = 1.8069, df = 44, p-value = 0.07763
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.02974979 0.51390724
## sample estimates:
## cor
## 0.262818r <- round(cor(RatingData$Consume.m.FAT, RatingData$LikeAd.m.FAT), 4)
r<- paste('r =',r)
p <- round(cor.test(RatingData$Consume.m.FAT, RatingData$LikeAd.m.FAT)$p.value, 4)
p <- paste('p =',p)
qplot(Consume.m.FAT, LikeAd.m.FAT, data = RatingData, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 5,2,label= r)+annotate('text', 5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
It’s clear that any use (using either a cigarette or e-cig) is profoundly driving the use ratings.
Now let’s look at these same plots for food.
cor.test(RatingData$LikeAd.m.FOOD, RatingData$LikeFood.m.FOOD)##
## Pearson's product-moment correlation
##
## data: RatingData$LikeAd.m.FOOD and RatingData$LikeFood.m.FOOD
## t = 8.5988, df = 44, p-value = 5.664e-11
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.6511614 0.8798483
## sample estimates:
## cor
## 0.7917872r <- round(cor(RatingData$LikeAd.m.FOOD, RatingData$LikeFood.m.FOOD), 4)
r<- paste('r =',r)
p <- round(cor.test(RatingData$LikeAd.m.FOOD, RatingData$LikeFood.m.FOOD)$p.value, 4)
p <- paste('p =',p)
qplot(LikeAd.m.FOOD, LikeFood.m.FOOD, data = RatingData, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 5,2,label= r)+annotate('text', 5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(RatingData$Consume.m.FOOD, RatingData$LikeFood.m.FOOD)##
## Pearson's product-moment correlation
##
## data: RatingData$Consume.m.FOOD and RatingData$LikeFood.m.FOOD
## t = 7.8509, df = 44, p-value = 6.611e-10
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.6084882 0.8628262
## sample estimates:
## cor
## 0.7638564r <- round(cor(RatingData$Consume.m.FOOD, RatingData$LikeFood.m.FOOD), 4)
r<- paste('r =',r)
p <- round(cor.test(RatingData$Consume.m.FOOD, RatingData$LikeFood.m.FOOD)$p.value, 4)
p <- paste('p =',p)
qplot(Consume.m.FOOD, LikeFood.m.FOOD, data = RatingData, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 5,2,label= r)+annotate('text', 5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(RatingData$Consume.m.FOOD, RatingData$LikeAd.m.FOOD)##
## Pearson's product-moment correlation
##
## data: RatingData$Consume.m.FOOD and RatingData$LikeAd.m.FOOD
## t = 5.4312, df = 44, p-value = 2.295e-06
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.4205600 0.7803072
## sample estimates:
## cor
## 0.6335138r <- round(cor(RatingData$Consume.m.FOOD, RatingData$LikeAd.m.FOOD), 4)
r<- paste('r =',r)
p <- round(cor.test(RatingData$Consume.m.FOOD, RatingData$LikeAd.m.FOOD)$p.value, 4)
p <- paste('p =',p)
qplot(Consume.m.FOOD, LikeAd.m.FOOD, data = RatingData, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 5,2,label= r)+annotate('text', 5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
Anyuse appears to be equally distributed, as it should be!
And now for TAT images
cor.test(RatingData$LikeAd.m.TAT, RatingData$LikeFood.m.TAT)##
## Pearson's product-moment correlation
##
## data: RatingData$LikeAd.m.TAT and RatingData$LikeFood.m.TAT
## t = 2.4129, df = 44, p-value = 0.02006
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.05722381 0.57507303
## sample estimates:
## cor
## 0.3418432r <- round(cor(RatingData$LikeAd.m.TAT, RatingData$LikeFood.m.TAT), 4)
r<- paste('r =',r)
p <- round(cor.test(RatingData$LikeAd.m.TAT, RatingData$LikeFood.m.TAT)$p.value, 4)
p <- paste('p =',p)
qplot(LikeAd.m.TAT, LikeFood.m.TAT, data = RatingData, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 4.5,1.6,label= r)+annotate('text', 4.5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(RatingData$Consume.m.TAT, RatingData$LikeFood.m.TAT)##
## Pearson's product-moment correlation
##
## data: RatingData$Consume.m.TAT and RatingData$LikeFood.m.TAT
## t = 6.1255, df = 44, p-value = 2.207e-07
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.4833179 0.8093314
## sample estimates:
## cor
## 0.6784282r <- round(cor(RatingData$Consume.m.TAT, RatingData$LikeFood.m.TAT), 4)
r<- paste('r =',r)
p <- round(cor.test(RatingData$Consume.m.TAT, RatingData$LikeFood.m.TAT)$p.value, 4)
p <- paste('p =',p)
qplot(Consume.m.TAT, LikeFood.m.TAT, data = RatingData, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 1.5,1.7,label= r)+annotate('text', 1.5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(RatingData$Consume.m.TAT, RatingData$LikeAd.m.TAT)##
## Pearson's product-moment correlation
##
## data: RatingData$Consume.m.TAT and RatingData$LikeAd.m.TAT
## t = 2.6169, df = 44, p-value = 0.01211
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.0858390 0.5940064
## sample estimates:
## cor
## 0.366992r <- round(cor(RatingData$Consume.m.TAT, RatingData$LikeAd.m.TAT), 4)
r<- paste('r =',r)
p <- round(cor.test(RatingData$Consume.m.TAT, RatingData$LikeAd.m.TAT)$p.value, 4)
p <- paste('p =',p)
qplot(Consume.m.TAT, LikeAd.m.TAT, data = RatingData, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 1.5,1.7,label= r)+annotate('text', 1.5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
Clearly some outliers in this data, specifically in the like food tat ratings. This only somewhat looks like it is driven by past use though.
Survey Measures
library(foreign)
rawSurvey = read.spss("C:/Users/londeree.4/Dropbox/Lab-Londeree/osu-certs-pilot/experiment-surveys/Survey/SPSSSurveys.sav")
#Select columns of interest and save to a new data frame
Survey <- data.frame(rawSurvey[c('SubID','everUse','cigIntent','ecigIntent', 'cigWill','ecigWill','FecigWill','cigProt', 'ecigProt','ecigAttitudes','aveSS')])Now that everything is loaded in, let’s look at some descriptives.
describe(Survey)## Survey
##
## 11 Variables 46 Observations
## ---------------------------------------------------------------------------
## SubID
## n missing distinct
## 46 0 46
##
## lowest : s01 s02 s03 s04 s05
## highest: s42 s43 s44 s45 s46
## ---------------------------------------------------------------------------
## everUse
## n missing distinct
## 46 0 2
##
## Value Not Used Used
## Frequency 34 12
## Proportion 0.739 0.261
## ---------------------------------------------------------------------------
## cigIntent
## n missing distinct Info Mean Gmd
## 46 0 6 0.436 1.348 0.629
##
## Value 1.0 1.5 2.0 3.0 4.0 5.0
## Frequency 38 2 1 2 2 1
## Proportion 0.826 0.043 0.022 0.043 0.043 0.022
## ---------------------------------------------------------------------------
## ecigIntent
## n missing distinct Info Mean Gmd
## 46 0 8 0.831 1.609 0.9005
##
## Value 1.0 1.5 2.0 2.5 3.0 3.5 4.0 5.0
## Frequency 25 9 4 2 2 1 2 1
## Proportion 0.543 0.196 0.087 0.043 0.043 0.022 0.043 0.022
## ---------------------------------------------------------------------------
## cigWill
## n missing distinct Info Mean Gmd
## 46 0 7 0.742 1.489 0.7937
##
## Value 1.0 1.5 2.0 2.5 3.5 4.0 5.0
## Frequency 29 9 3 1 1 1 2
## Proportion 0.630 0.196 0.065 0.022 0.022 0.022 0.043
## ---------------------------------------------------------------------------
## ecigWill
## n missing distinct Info Mean Gmd
## 46 0 8 0.834 1.87 1.32
##
## Value 1.0 1.5 2.0 3.0 3.5 4.5 5.0 6.0
## Frequency 25 6 7 1 1 1 3 2
## Proportion 0.543 0.130 0.152 0.022 0.022 0.022 0.065 0.043
## ---------------------------------------------------------------------------
## FecigWill
## n missing distinct Info Mean Gmd .05 .10
## 46 0 11 0.934 2.304 1.752 1.00 1.00
## .25 .50 .75 .90 .95
## 1.00 1.50 2.50 5.00 6.75
##
## Value 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 6.0
## Frequency 18 6 7 4 2 1 1 1 2 1
## Proportion 0.391 0.130 0.152 0.087 0.043 0.022 0.022 0.022 0.043 0.022
##
## Value 7.0
## Frequency 3
## Proportion 0.065
## ---------------------------------------------------------------------------
## cigProt
## n missing distinct Info Mean Gmd .05 .10
## 46 0 31 0.997 3.278 1.571 1.425 1.650
## .25 .50 .75 .90 .95
## 2.425 3.000 3.800 5.000 5.825
##
## lowest : 1.0 1.1 1.4 1.5 1.6, highest: 5.1 5.3 6.0 7.7 8.4
## ---------------------------------------------------------------------------
## ecigProt
## n missing distinct Info Mean Gmd .05 .10
## 46 0 30 0.998 3.393 1.373 1.550 1.950
## .25 .50 .75 .90 .95
## 2.700 3.100 4.175 5.000 5.575
##
## lowest : 1.0 1.4 1.5 1.7 1.9, highest: 5.0 5.2 5.7 6.0 6.2
## ---------------------------------------------------------------------------
## ecigAttitudes
## n missing distinct Info Mean Gmd .05 .10
## 46 0 20 0.994 1.499 0.3867 1.050 1.050
## .25 .50 .75 .90 .95
## 1.212 1.450 1.700 1.875 2.137
##
## Value 1.00 1.05 1.15 1.20 1.25 1.30 1.35 1.40 1.45 1.50
## Frequency 2 4 1 5 1 2 2 4 4 3
## Proportion 0.043 0.087 0.022 0.109 0.022 0.043 0.043 0.087 0.087 0.065
##
## Value 1.55 1.60 1.70 1.75 1.80 1.95 2.10 2.15 2.20 2.70
## Frequency 1 2 6 2 2 1 1 1 1 1
## Proportion 0.022 0.043 0.130 0.043 0.043 0.022 0.022 0.022 0.022 0.022
## ---------------------------------------------------------------------------
## aveSS
## n missing distinct Info Mean Gmd .05 .10
## 46 0 16 0.995 2.073 0.7202 1.250 1.312
## .25 .50 .75 .90 .95
## 1.625 1.938 2.625 2.875 3.188
##
## Value 1.125 1.250 1.375 1.500 1.625 1.750 1.875 2.000 2.125 2.250
## Frequency 2 3 3 3 5 3 4 2 2 3
## Proportion 0.043 0.065 0.065 0.065 0.109 0.065 0.087 0.043 0.043 0.065
##
## Value 2.375 2.500 2.625 2.750 3.000 3.250
## Frequency 1 1 4 5 2 3
## Proportion 0.022 0.022 0.087 0.109 0.043 0.065
## ---------------------------------------------------------------------------Let’s look and see how are measures are related and distributed, but not care too much about thier correlations.
library(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:arm':
##
## logit, rescale, sim## The following object is masked from 'package:Hmisc':
##
## describe## The following objects are masked from 'package:ggplot2':
##
## %+%, alphapairs.panels(Survey[sapply(Survey, is.numeric)], stars =T)
Combined Analysis
First let’s load in the data we want specifically, and look at a messy pairwise comparison.
alldata <- bind_cols(allagg,RatingData,Survey)
pairs.panels(alldata[c(2:5,7:9,13:15,19:21)], stars =T)
#pairs.panels(alldata[c(2:5,27:33)], stars =T)
#pairs.panels(alldata[c(7:9,13:15,19:21,27:31)], stars =T)FAT Eye-tracking and Behavioral rating analysis
These charts are too much, but they give us a sense of what we are working with. Let’s take a closer look at the fat dwell time and fixation count correlations with behavioral ratings. Let’s also note the variace of these ratings.
FAT like ad SD
sd(alldata$LikeAd.m.FAT )## [1] 1.210648FAT like food SD
sd( alldata$LikeFood.m.FAT)## [1] 1.567364FAT consume SD
sd(alldata$Consume.m.FAT)## [1] 0.9711847FAT Dwell time and ratings
cor.test(alldata$DTFAT, alldata$LikeFood.m.FAT)##
## Pearson's product-moment correlation
##
## data: alldata$DTFAT and alldata$LikeFood.m.FAT
## t = 2.7035, df = 44, p-value = 0.009716
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.09784755 0.60178762
## sample estimates:
## cor
## 0.3774249r <- round(cor(alldata$DTFAT, alldata$LikeFood.m.FAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$DTFAT, alldata$LikeFood.m.FAT)$p.value, 4)
p <- paste('p =',p)
qplot(DTFAT, LikeFood.m.FAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', .3,2,label= r)+annotate('text', .3,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(alldata$DTFAT, alldata$LikeAd.m.FAT)##
## Pearson's product-moment correlation
##
## data: alldata$DTFAT and alldata$LikeAd.m.FAT
## t = 2.193, df = 44, p-value = 0.03364
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.02596916 0.55373943
## sample estimates:
## cor
## 0.3139008r <- round(cor(alldata$DTFAT, alldata$LikeAd.m.FAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$DTFAT, alldata$LikeAd.m.FAT)$p.value, 4)
p <- paste('p =',p)
qplot(DTFAT, LikeAd.m.FAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', .3,2,label= r)+annotate('text', .3,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(alldata$DTFAT, alldata$Consume.m.FAT)##
## Pearson's product-moment correlation
##
## data: alldata$DTFAT and alldata$Consume.m.FAT
## t = 2.5094, df = 44, p-value = 0.01585
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.0708141 0.5841348
## sample estimates:
## cor
## 0.3538382r <- round(cor(alldata$DTFAT, alldata$Consume.m.FAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$DTFAT, alldata$Consume.m.FAT)$p.value, 4)
p <- paste('p =',p)
qplot(DTFAT, Consume.m.FAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', .3,2,label= r)+annotate('text', .3,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
FAT Fixation count and ratings
cor.test(alldata$FCFAT, alldata$LikeFood.m.FAT)##
## Pearson's product-moment correlation
##
## data: alldata$FCFAT and alldata$LikeFood.m.FAT
## t = 2.682, df = 44, p-value = 0.01027
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.09487612 0.59987107
## sample estimates:
## cor
## 0.3748499r <- round(cor(alldata$DTFAT, alldata$LikeFood.m.FAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$FCFAT, alldata$LikeFood.m.FAT)$p.value, 4)
p <- paste('p =',p)
qplot(FCFAT, LikeFood.m.FAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 5,2,label= r)+annotate('text', 5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(alldata$FCFAT, alldata$LikeAd.m.FAT)##
## Pearson's product-moment correlation
##
## data: alldata$FCFAT and alldata$LikeAd.m.FAT
## t = 1.7939, df = 44, p-value = 0.0797
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.0316289 0.5125218
## sample estimates:
## cor
## 0.2610662r <- round(cor(alldata$FCFAT, alldata$LikeAd.m.FAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$FCFAT, alldata$LikeAd.m.FAT)$p.value, 4)
p <- paste('p =',p)
qplot(FCFAT, LikeAd.m.FAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 5,2,label= r)+annotate('text', 5,1.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(alldata$FCFAT, alldata$Consume.m.FAT)##
## Pearson's product-moment correlation
##
## data: alldata$FCFAT and alldata$Consume.m.FAT
## t = 1.1995, df = 44, p-value = 0.2368
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.1184786 0.4452386
## sample estimates:
## cor
## 0.1779395r <- round(cor(alldata$FCFAT, alldata$Consume.m.FAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$FCFAT, alldata$Consume.m.FAT)$p.value, 4)
p <- paste('p =',p)
qplot(FCFAT, Consume.m.FAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 5,4,label= r)+annotate('text', 5,4.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
From this we can see that the variance is good for all fat measures. Only the consume correlations seem to be particularly driven by users.
TAT Eye-tracking and Behavioral rating analysis
Now let’s take a look at the same for TAT, starting with and examination of variance.
The SD for TAT like ad
sd(alldata$LikeAd.m.TAT )## [1] 0.9476501The SD for TAT like food
sd( alldata$LikeFood.m.TAT)## [1] 0.1500631The SD for TAT consume
sd(alldata$Consume.m.TAT)## [1] 0.2210019Now let’s look at the correlations and individually plot the relationships between eye-tracking measures and other measures.
TAT Dwell time and ratings
cor.test(alldata$DTTAT, alldata$LikeFood.m.TAT)##
## Pearson's product-moment correlation
##
## data: alldata$DTTAT and alldata$LikeFood.m.TAT
## t = 0.022508, df = 44, p-value = 0.9821
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.2871878 0.2934022
## sample estimates:
## cor
## 0.003393153r <- round(cor(alldata$DTTAT, alldata$LikeFood.m.TAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$DTTAT, alldata$LikeFood.m.TAT)$p.value, 4)
p <- paste('p =',p)
qplot(DTTAT, LikeFood.m.TAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', .15,1.5,label= r)+annotate('text', .15,1.3,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(alldata$DTTAT, alldata$LikeAd.m.TAT)##
## Pearson's product-moment correlation
##
## data: alldata$DTTAT and alldata$LikeAd.m.TAT
## t = 1.6939, df = 44, p-value = 0.09736
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.04619564 0.50168465
## sample estimates:
## cor
## 0.2474204r <- round(cor(alldata$DTTAT, alldata$LikeAd.m.TAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$DTTAT, alldata$LikeAd.m.TAT)$p.value, 4)
p <- paste('p =',p)
qplot(DTTAT, LikeAd.m.TAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', .15,1.5,label= r)+annotate('text', .15,1.3,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(alldata$DTTAT, alldata$Consume.m.TAT)##
## Pearson's product-moment correlation
##
## data: alldata$DTTAT and alldata$Consume.m.TAT
## t = -0.00064734, df = 44, p-value = 0.9995
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.2903874 0.2902087
## sample estimates:
## cor
## -9.75908e-05r <- round(cor(alldata$DTTAT, alldata$Consume.m.TAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$DTTAT, alldata$Consume.m.TAT)$p.value, 4)
p <- paste('p =',p)
qplot(DTTAT, Consume.m.TAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', .15,1.5,label= r)+annotate('text', .15,1.3,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
TAT Fixation count and ratings
cor.test(alldata$FCTAT, alldata$LikeFood.m.TAT)##
## Pearson's product-moment correlation
##
## data: alldata$FCTAT and alldata$LikeFood.m.TAT
## t = 0.4087, df = 44, p-value = 0.6847
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.2329601 0.3456247
## sample estimates:
## cor
## 0.06149684r <- round(cor(alldata$DTTAT, alldata$LikeFood.m.TAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$FCTAT, alldata$LikeFood.m.TAT)$p.value, 4)
p <- paste('p =',p)
qplot(FCTAT, LikeFood.m.TAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 3,1.5,label= r)+annotate('text', 3,1.3,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(alldata$FCTAT, alldata$LikeAd.m.TAT)##
## Pearson's product-moment correlation
##
## data: alldata$FCTAT and alldata$LikeAd.m.TAT
## t = 2.2021, df = 44, p-value = 0.03294
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.02727366 0.55464392
## sample estimates:
## cor
## 0.3150771r <- round(cor(alldata$FCTAT, alldata$LikeAd.m.TAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$FCTAT, alldata$LikeAd.m.TAT)$p.value, 4)
p <- paste('p =',p)
qplot(FCTAT, LikeAd.m.TAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text',3,4,label= r)+annotate('text', 3,3.5,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
cor.test(alldata$FCTAT, alldata$Consume.m.TAT)##
## Pearson's product-moment correlation
##
## data: alldata$FCTAT and alldata$Consume.m.TAT
## t = 0.46625, df = 44, p-value = 0.6433
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.2247563 0.3532249
## sample estimates:
## cor
## 0.07011663r <- round(cor(alldata$FCTAT, alldata$Consume.m.TAT), 4)
r<- paste('r =',r)
p <- round(cor.test(alldata$FCTAT, alldata$Consume.m.TAT)$p.value, 4)
p <- paste('p =',p)
qplot(FCTAT, Consume.m.TAT, data = alldata, main= "Rating Correlation") + geom_smooth(method = 'lm')+ annotate('text', 3,1.5,label= r)+annotate('text', 3,1.3,label= p)+geom_point(aes(colour= factor(demographics$AnyUse)))
From this we can see that the variance is quite low for tat like food and consume. Still the correlation between like ad is trending for dwell time and significant for fixation count.