In this data set, individuals were presented with 3D panoramic indoor and outdoor scenes. They viewed each image for a set period of time, and were told to study the images for a later memory (recognition) task. Participants sat in the centre of a sphere, but were free to move their head and eyes while studying the scenes.
The goal of this project/analysis is to document patterns in individuals’ head and eye movements, and to identify whether there were consistent individual differences in individuals’ head and/or eye movement patterns.
I took a slightly more conservative approach by looking at only the outdoor/landscame scenes instead of both indoor and outdoor scenes, in case there were systematic differences in how individuals processed these two types of scenes. Later in the project, I hope to incorporate the indoor scenes.
Note: This is a comprehensive document where I walk through my decision-making process and contains a very detailed/thorough set of visualization of the data. If you’re not interested in this, I have provided a brief summary of what I did at the start of the model-based clustering analysis document, so you can refer to that document if you just want to look at the variables included/results.
Load libraries
library(ggplot2)
library(viridis)
library(beepr)
library(aspace)
library(sf)
library(plyr)
library(wesanderson)
library(reshape2)
source("calc_sde_mod.R")Load data
# ------------- data cleaning -------------------
dfe<-read.table("encoding_all_fixations.txt", sep=",", header=T)
# renaming variable names
names(dfe)[c(2,5,6, 20,21)]<-c("subject", "fixx", "fixy", "fix_headx", "fix_heady")
dfe$subject<-as.factor(dfe$subject) # factorize subject column
dfe$stim_type<-factor(dfe$stim_type) # factorize stim_type
# convert Nan into Na
is.nan.data.frame <- function(x)
do.call(cbind, lapply(x, is.nan))
dfe[is.nan(dfe)] <- NA
# create subset for just outdoor stim
outdoor<-subset(dfe, dfe$stim_type=="outdoor")
# ensure that this stim contains only complete observations for the long and lat variables
land<-outdoor[!(is.na(outdoor$fixy)|is.na(outdoor$fixx)|is.na(outdoor$fix_headx)|is.na(outdoor$fix_headx)),]
# changing stim name
land$stim_name<-gsub("outdoor_pano_", "", land$stim_name)
# ---------------------------- lists for for loop generation -----------------------------------
sujs<-sort(unique(land$subject)) # generate a unique list of subject IDs
stim<-sort(unique(land$stim_name)) # generate a unique list of stimuli ID
# --------------------------- vector variables for graphing ------------------------------
# colour palette for subject-level analysis
palette<-c(wes_palettes$Darjeeling1, wes_palettes$GrandBudapest1, wes_palettes$GrandBudapest2, wes_palettes$Moonrise3, wes_palettes$Moonrise2)
# colour for creating a manual legend
colors <- c("Head" = "lightseagreen", "Eyes" = "coral1") # for creating a manual legendNote: 4/32652 data points from the landscape data set were removed due to there being missing data in the eye or head movement coordinate data; given the small number of observations removed, this won’t affect the interpretation of the results too much.
First, I spent some time trying to understand the data, first starting with the eye/head movement of one participant during one trial, then looking at the eye/head movement pattern of one participant across all trials.
sub3<-subset(dfe, subject=="2" & stim_type=="outdoor")
# sub$trialnum<-factor(sub$trialnum)
ggplot(sub3, aes(x=fixx, y=fixy, colour=fixnum))+
geom_point(size=3)+
facet_wrap(trialnum~., ncol=6)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
# ,legend.position="none"
)+
# scale_fill_continuous(guide="legend")+
scale_color_viridis(direction=-1)+
guides(colour=guide_colourbar(reverse=T))sub3<-subset(dfe, subject=="2" & stim_type=="outdoor")
# sub$trialnum<-factor(sub$trialnum)
ggplot(sub3, aes(x=fix_headx, y=fix_heady, colour=fixnum))+
geom_point(size=3)+
facet_wrap(trialnum~., ncol=6)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
# ,legend.position="none"
)+
# scale_fill_continuous(guide="legend")+
scale_color_viridis(direction=-1)+
guides(colour=guide_colourbar(reverse=T))
Off the bat, I think there should be some sort of parameter(s) to capture the overall spread of eye movements. One way to do this is to measure the standard deviation area of these eye movements (similar to unidimensional spread/variance, but in 2D space).
For this section, I will be examining a few aspects of the data in detail in an attempt to capture eye/head movement accurately. These variables/aspects are listed below:
For each variable, I will take a look at the data at the fixation level for every participant (that is, observation is one fixation in the visualization), then take a look at the data at the trial level for each participant (i.e., every observation is an aggregate measure of fixations for each scene presented).
Constructing relevant data frames:
SDE:
# sde.look<-NULL
# sde.head<-NULL
#
# # calculating SDD using calc_sdd from 'aspace' package
# for(s in sujs){ # subset by participant
# persuj<-subset(land, subject==s)
# for(i in stim){ # subset by each stim
#
# # include only the coordinates columns for eye movements for a given trial
# perstim.look<-persuj[persuj$stim_name==i,][c("fixx", "fixy")]
#
# # include only the coordinates columns for head movements for a given trial
# perstim.head<-persuj[persuj$stim_name==i,][c("fix_headx", "fix_heady")]
#
# # skip SDE calculation if there are less than 3 data points per trial
# if (nrow(perstim.look)<3) {
# next
# }
#
# # calculat SDE if there are more than 3 data points
# else {
# # obtaining SDE stats for eye movements
# look<-calc_sde_mod(id=paste0(s, "_", i),
# # filename=paste0("SDE_look_", s, "_", i, ".txt"),
# centre.xy=NULL, calccentre=TRUE,
# weighted=FALSE, weights=NULL, points=perstim.look, verbose=FALSE)
#
# head<-calc_sde_mod(id=paste0(s, "_", i),
# # filename=paste0("SDE_head_", s, "_", i, ".txt"),
# centre.xy=NULL, calccentre=TRUE,
# weighted=FALSE, weights=NULL, points=perstim.head, verbose=FALSE)
# }
#
# # store calc_sde results
#
# sde.look<-rbind(sde.look, look)
# sde.head<-rbind(sde.head, head)
# }
# }
#
# beep(sound = 3)
#
# # separate the name column into subject and stim_name
# sde.look<-cbind(sde.look, strcapture("(.*)_(.*)", as.character(sde.look$id), data.frame(subject = "", stim_name="")))
# sde.head<-cbind(sde.head, strcapture("(.*)_(.*)", as.character(sde.head$id), data.frame(subject = "", stim_name="")))
#
# # write data frames to file
# write.csv(sde.look, "VR_Basic Scene Viewing_Eye Movement SDE.csv", row.names=F)
# write.csv(sde.head, "VR_Basic Scene Viewing_Head Movement SDE.csv", row.names=F)sde.look<-read.csv("VR_Basic Scene Viewing_Eye Movement SDE.csv")
sde.head<-read.csv("VR_Basic Scene Viewing_Head Movement SDE.csv")
sde.look$subject<-factor(sde.look$subject)
sde.head$subject<-factor(sde.head$subject)Angle change:
# df.angle<-NULL
#
# # in order to calculate difference scores, the first instance of dir variable is set to 0
# fix<-land
# fix$sacc_dir<-car::recode(fix$sacc_dir, "NA=0")
# fix$fix_headdir<-car::recode(fix$fix_headdir, "NA=0")
#
#
# for (s in sujs){ # create data frame per participant
# persuj<-subset(fix, subject==s)
# for (i in stim){ # subset it based on stim
# perstim<-subset(persuj, stim_name==i)
#
# # for every row
# for (j in 1:nrow(perstim)){
# if (perstim$fixnum[j]==1){
# perstim$saccDelta[j]<-NA
# perstim$headDelta[j]<-NA
# perstim$saccDirDelta[j]<-NA
# perstim$headDirDelta[j]<-NA
# } else if (perstim$fixnum[j]>1){
# perstim$saccDelta[j]<-perstim$sacc_dir[j]-perstim$sacc_dir[j-1] # raw difference score between eye movement dir
# perstim$headDelta[j]<-perstim$fix_headdir[j]-perstim$fix_headdir[j-1] # raw difference score between head dir
#
# # calculate minimum absolute angle change between two vectors for saccades
# perstim$saccDirDelta[j]<-ifelse(abs(perstim$saccDelta[j])<=360-abs(perstim$saccDelta[j]),
# abs(perstim$saccDelta[j]),
# 360-abs(perstim$saccDelta[j]))
# # do the same for head direction
# perstim$headDirDelta[j]<-ifelse(abs(perstim$headDelta[j])<=360-abs(perstim$headDelta[j]),
# abs(perstim$headDelta[j]),
# 360-abs(perstim$headDelta[j]))
# }
# }
# df.angle<-rbind(df.angle, perstim)
# }
# }
#
#
# beep(sound=3)
#
# # recode first instance as NA instead of 0
# df.angle$sacc_amp<-car::recode(df.angle$sacc_amp, "0=NA")
# df.angle$sacc_dir<-car::recode(df.angle$sacc_dir, "0=NA")
# df.angle$fix_headamp<-car::recode(df.angle$fix_headamp, "0=NA")
# df.angle$fix_headdir<-car::recode(df.angle$fix_headdir, "0=NA")
#
# write.csv(df.angle, "VR_Basic Scene Viewing_Angle Direction.csv", row.names = F)df.angle<-read.csv("VR_Basic Scene Viewing_Angle Direction.csv")
df.angle$subject<-factor(df.angle$subject)Trial-Level Summary Data:
df.sum<-ddply(df.angle, .(subject, stim_name), summarise,
# mean and SD of eye/head movement amplitude
sacc_amp_avg=mean(sacc_amp, na.rm=T),
sacc_amp_sd=sd(sacc_amp, na.rm=T),
head_amp_avg=mean(fix_headamp, na.rm=T),
head_amp_sd=sd(fix_headamp, na.rm=T),
# mean and SD of head/eye movement direction
sacc_dir_avg=mean(sacc_dir, na.rm=T),
sacc_dir_sd=sd(sacc_dir, na.rm=T),
head_dir_avg=mean(fix_headdir, na.rm=T),
head_dir_sd=sd(fix_headdir, na.rm=T),
# mean and SD of angle change between eye movement vectors
sacc_angle_avg=mean(saccDirDelta, na.rm=T),
sacc_angle_sd=sd(saccDirDelta, na.rm=T),
head_angle_avg=mean(headDirDelta, na.rm=T),
head_angle_sd=sd(headDirDelta, na.rm=T),
# fixation duration
fixdur_avg=mean(fixdur, na.rm=T),
fixdur_sd=sd(fixdur, na.rm=T),
# head rotation
head_rot_avg=mean(fix_headrot, na.rm=T),
head_rot_avg=sd(fix_headrot, na.rm=T)
)The aspace package has code that calculates the standard deviation elipse (SDE) of points on a 2D plane. I simply modified the code a bit such that it would provide the summary output instead of the shapefile information.
ggplot(sde.look, aes(x=CENTRE.x, y=CENTRE.y, colour=subject))+
geom_point(size=3, alpha=0.6)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
# ,legend.position="none"
)+
coord_cartesian(xlim = c(-180,180), ylim=c(-90, 90))+
scale_colour_manual(values=palette)ggplot(sde.head, aes(x=CENTRE.x, y=CENTRE.y, colour=subject))+
geom_point(size=3, alpha=0.6)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
# ,legend.position="none"
)+
coord_cartesian(xlim = c(-180,180), ylim=c(-90, 90))+
scale_colour_manual(values=palette)Here’s a look at the central tendency/spread with the areas overlayed:
ggplot(land, aes(x=fixx, y=fixy, group=stim_name)) +
geom_point(data=sde.look, aes(x=CENTRE.x, y=CENTRE.y), alpha=0.4)+
stat_ellipse(alpha=0.2, colour="coral1")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
# ,legend.position="none"
)+
scale_x_continuous(breaks=seq(-360, 360, 90))+
scale_y_continuous(breaks=seq(-360,360,45))+
coord_cartesian(xlim = c(-180,180), ylim=c(-90, 90))ggplot(land, aes(x=fix_headx, y=fix_heady, group=stim_name)) +
geom_point(data=sde.head, aes(x=CENTRE.x, y=CENTRE.y), alpha=0.4)+
stat_ellipse(alpha=0.2, colour="lightseagreen")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
# ,legend.position="none"
)+
scale_x_continuous(breaks=seq(-360, 360, 90))+
scale_y_continuous(breaks=seq(-360,360,45))+
coord_cartesian(xlim = c(-180,180), ylim=c(-90, 90))The black dots represent the centre of the standard deviation ellipse, and the area covered by the elipse is outlined in colour.
the calc_sde function breaks this down into several aspects. Below, I’ve provided visual representation of the data at the participant-level, with each observation representing aggregate reponses for each trial/scene.
# graph
ggplot(sde.look, aes(x=Area.sde, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Area", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# graph
ggplot(sde.head, aes(x=Area.sde, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Area", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
The distributions generally look Gaussian; as such, mean and SD will be used to capture this set of data.
Eccentricity is a ratio that measures how “stretched out” an elipse is; the closer eccentricity is to 1, the closer it is to looking like a circle.
ggplot(sde.look, aes(x=Eccentricity, na.rm = TRUE, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Eccentricity/Stretch", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(sde.head, aes(x=Eccentricity, na.rm = TRUE, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Eccentricity/Stretch", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Given the severe negative skew in the trial-level data per participant, it may be best to try and model this using an exponential function
Theta is a measure of the tilt of the Elipse. For instance, an elipse stretched along the horizon would have a Theta of roughly 90 degrees.
theta.means<-ddply(sde.look, .(subject), summarise,
mean.theta= paste0("M = ", round(mean(Theta),1)),
sd.theta = paste0("SD = ", round(sd(Theta),1)))
ggplot(sde.look, aes(x=Theta, na.rm = TRUE, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Theta", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)+
geom_text(data = theta.means, aes(x = -Inf, y = -Inf, label = mean.theta), hjust = -0.1, vjust = -6)+
geom_text(data = theta.means, aes(x = -Inf, y = -Inf, label = sd.theta), hjust = -0.1, vjust = -4.5)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
theta.means<-ddply(sde.head, .(subject), summarise,
mean.theta= paste0("M = ", round(mean(Theta),1)),
sd.theta = paste0("SD = ", round(sd(Theta),1)))
ggplot(sde.head, aes(x=Theta, na.rm = TRUE, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Theta", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)+
geom_text(data = theta.means, aes(x = -Inf, y = -Inf, label = mean.theta), hjust = -0.1, vjust = -6)+
geom_text(data = theta.means, aes(x = -Inf, y = -Inf, label = sd.theta), hjust = -0.1, vjust = -4.5)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
I displayed the mean and SD to see how much variation there was (especially in the means). Even though most of Thetas were centered around 90 degrees (i.e., along the horizon), there is still considerable difference in the mean Theta from participant to participant.
As such, given the approximately Gaussian distribution, mean and SD will be used to capture this set of data.
Saccade/head direction indicates the direction of movement. I’ve presented the data in a polar histogram.
ggplot(df.angle, aes(x=sacc_dir, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, binwidth = 6, position="dodge")+
coord_polar()+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Saccade Direction", expand = c(0,0),breaks=seq(0, 359, 45), limits=c(0, max(df.angle$sacc_amp)))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)ggplot(df.angle, aes(x=fix_headdir, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, binwidth = 6, position="dodge")+
coord_polar()+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Saccade Direction", expand = c(0,0),breaks=seq(0, 359, 45), limits=c(0, max(df.angle$sacc_amp)))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)In examining the fixation-level data, it’s more accurate to think of saccade/head direction as having a bimodal distribution, with a peak at around 90 degrees and the other at 270 degrees. As such, simply calculating a mean for these values would not be representative of the model (i.e., the mean will be at 180 degrees, but the majority of the points actually fall on either 90 or 270 degrees).
There doesn’t seem to be a straightforward way to capture this bimodal (though I’m open to ideas). For now, I’ve used mean & SD to represent the trial-level data
ggplot(df.sum)+
geom_histogram(aes(x=head_dir_avg, na.rm = TRUE, colour="Head", fill="Head"), alpha=0.4)+
geom_histogram(aes(x=sacc_dir_avg, na.rm = TRUE, colour="Eyes", fill="Eyes"), alpha=0.4)+
facet_wrap(.~subject)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
# ,legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Mean Direction", expand = c(0,0), breaks = seq(0, 300, 50))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual("Legend", values = colors)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
These are metrics derived from the sacc_dir and fix_headdir variables. Angle change is different than saccade/head direction, as it indicates the change between two angle vectors.
The two key variables calculated are saccDirDelta (contains directionality) and headDirDelta (absolute angle difference with no direction/sign) which are the minimum angle change between eye or head movements. Since they are minimum angle changes, these variables area always less than 180 angular degrees.
Here is a histogram of the minimum angle changes for eye and head movement side by side:
ggplot(df.angle)+
geom_histogram(aes(x=headDirDelta, na.rm = TRUE, colour="Head", fill="Head"), alpha=0.4)+
geom_histogram(aes(x=saccDirDelta, na.rm = TRUE, colour="Eyes", fill="Eyes"), alpha=0.4)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
# ,legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Angles", expand = c(0,0),breaks=seq(0, 180, 30))+
scale_y_continuous(expand = c(0,0), limits = c(0,9000))+
scale_fill_manual("Legend", values = colors)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Consistent with previous data, it seems that people generally tend not to make really big big head movements changes compared to eye movements
The same graph but separated for each participant:
# list that generates count of subjects
list<-as.data.frame(table(df.angle$subject))
names(list)<-c("subject", "label")
# graph
ggplot(df.angle, aes(x=saccDirDelta, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, binwidth = 6, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Angle Change", expand = c(0,0),breaks=seq(0, 180, 30))+
scale_y_continuous(expand = c(0,0), limits=c(0,250))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)+
# geom_hline(yintercept=250, linetype="dotted")+
# annotate(geom="text", x=100, y=600, label=list)
geom_text(data = list, aes(x = -Inf, y = -Inf, label = label), hjust = -4, vjust = -6)ggplot(df.angle, aes(x=headDirDelta, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, binwidth = 6, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Angle Change", expand = c(0,0),breaks=seq(0, 180, 30))+
scale_y_continuous(expand = c(0,0), limits=c(0,550))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)+
# geom_hline(yintercept=500, linetype="dotted")+
# annotate(geom="text", x=100, y=600, label=list)
geom_text(data = list, aes(x = -Inf, y = -Inf, label = label), hjust = -4, vjust = -6)ggplot(df.sum)+
geom_histogram(aes(x=head_angle_avg, na.rm = TRUE, colour="Head", fill="Head"), alpha=0.4)+
geom_histogram(aes(x=sacc_angle_avg, na.rm = TRUE, colour="Eyes", fill="Eyes"), alpha=0.4)+
facet_wrap(.~subject)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
# ,legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Mean Angle Change", expand = c(0,0), breaks = seq(0, 300, 30))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual("Legend", values = colors)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
These distributions look roughly Gaussian, so mean and SD will be used to capture the data
# graph
ggplot(df.angle, aes(x=sacc_amp, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, binwidth = 6, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Saccade Amplitude", expand = c(0,0),breaks=seq(0, 180, 30), limits=c(0, max(df.angle$sacc_amp)))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)# graph
ggplot(df.angle, aes(x=fix_headamp, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, binwidth = 6, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Head Amplitude", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)ggplot(df.sum)+
geom_histogram(aes(x=head_amp_avg, na.rm = TRUE, colour="Head", fill="Head"), alpha=0.4)+
geom_histogram(aes(x=sacc_amp_avg, na.rm = TRUE, colour="Eyes", fill="Eyes"), alpha=0.4)+
facet_wrap(.~subject)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
# ,legend.position="none"
)+
labs(color = "Legend") +
scale_x_continuous("Mean Amplitude", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual("Legend", values = colors)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
The data here also look approximately Gaussian.
ggplot(df.angle, aes(x=fixdur, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend")+
scale_x_continuous("Fixation Duration", expand = c(0,0), breaks=seq(0, 5000, 1000))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(df.sum, aes(x=fixdur_avg, na.rm=T, fill=subject, group=subject, colour=subject))+
geom_histogram(alpha=0.4)+
facet_wrap(.~subject)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.key = element_rect(fill = "transparent", colour = "transparent")
,legend.position="none"
)+
scale_x_continuous("Mean Fixation Duration", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values = palette)+
scale_colour_manual(values=palette)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
The data here also look approximately Gaussian.
ggplot(df.angle, aes(x=fix_headrot, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend")+
scale_x_continuous("Head Rotation", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(df.sum, aes(x=head_rot_avg, na.rm = TRUE, group=subject, colour=subject, fill=subject))+
geom_histogram(alpha=0.4, position="dodge")+
facet_wrap(subject~.)+
theme(
panel.background= element_rect(fill=NA), # transparent panel
plot.background = element_rect(fill=NA, colour=NA), #transparent background
panel.grid=element_blank(), # remove panel grid
axis.ticks=element_line(colour="gray70"), # change colour of tick marks
panel.border = element_rect(fill="transparent", colour="gray70"), # change panel border colour
legend.background = element_rect(fill = "transparent", colour = "transparent"), # change legend background
axis.text = element_text(color="gray20"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
strip.background = element_rect(color="gray70", fill="transparent", linetype="solid"),
legend.position="none"
)+
labs(color = "Legend")+
scale_x_continuous("Mean Head Rotation", expand = c(0,0))+
scale_y_continuous(expand = c(0,0))+
scale_fill_manual(values=palette)+
scale_colour_manual(values=palette)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
The data here also look approximately Gaussian.
Quick Note: Even though I calculated both mean and sd for most of the measures at the trial-level, I chose only to examine the means in the end, since calculating SD isn’t very informative for distributions that aren’t Gaussian.
sde.h<-sde.head[c("subject", "stim_name", "CENTRE.x", "CENTRE.y", "Theta", "Eccentricity", "Area.sde")] # only grab the relevant columns
names(sde.h)[c(3:ncol(sde.h))]<-c("head.cx", "head.cy", "head.theta", "head.ecc", "head.area") # rename data for merging
sde.l<-sde.look[c("subject", "stim_name", "CENTRE.x", "CENTRE.y", "Theta", "Eccentricity", "Area.sde")]
names(sde.l)[c(3:ncol(sde.l))]<-c("sacc.cx", "sacc.cy", "sacc.theta", "sacc.ecc", "sacc.area")
# merge the head and saccade data sets
sde<-merge(sde.l, sde.h, by=c("subject", "stim_name"))
# merge sde data set with df.sum
comb<-merge(df.sum, sde, by=c("subject", "stim_name"), all.x=T, all.y=F)
# write.csv(comb, "VR_Basic Scene Viewing_Summary Per Trial_Updated 11Nov2020.csv", row.names = F)