msgs <- messages$msg#
properties <- c()#
markers <- c()#
i <- 1#
l <- length(msgs)#
while (msgs[i] != "TRIAL_START") i <- i + 1#
while (i <= l) {#
msg <- msgs[i]#
if (msg == "TRIAL_STOP") {#
markers <- c(markers, msg)#
# TODO: Put trial ids to markers.#
return(list(properties=properties, markers=markers))#
}#
msg <- strsplit(msg, ":")[[1]]#
if (length(msg) == 1)#
markers <- c(markers, msg)#
else#
properties <- c(properties, msg[1])#
i <- i + 1#
}#
# This should never happen, but anyway:#
warning("extract_attribute_names couldn't find TRIAL_STOP marker.")#
return(list(properties=properties, markers=markers))#
}#
#
# Returns a data frame containing a row for each trial and a column for every#
# porperty and marker.  Properties are name value pairs, a marker is just an#
# event with no further value, e.g. TRIAL_START.  The columns for the markers#
# list the times when they happened.#
extract_trial_attributes <- function(messages) {#
#
# TODO: ignore Calibration messages.#
#
attributes <- extract_attribute_names(messages)#
no_trials <- nrow(subset(messages, msg=="TRIAL_START"))#
#
# Create an appropriate data frame:#
properties <- list()#
markers <- list()#
for (property in attributes$properties) {#
properties[[property]] <- character(no_trials)#
}#
for (marker in attributes$markers) {#
markers[[marker]] <- double(no_trials)#
}#
#
# Now fill-in the values:#
msgs <- messages$msg#
time <- messages$time#
i <- 1#
l <- length(msgs)#
cur_trial <- 0                       # assuming that we always start with 1.#
while (msgs[i] != "TRIAL_START") i <- i + 1#
while (i <= l) {#
msg <- msgs[i]#
msg <- strsplit(msg, ":")[[1]]#
name <- msg[[1]]#
if (name == "TRIAL_START")#
cur_trial <- cur_trial + 1#
if (any(name == attributes$markers))#
markers[[name]][cur_trial] <- time[i]#
else {#
# TODO: save everything following the first colon:#
properties[[name]][cur_trial] <- substring(msgs[i], nchar(name)+2)#
}#
i <- i + 1#
}#
#
properties$Trial <- as.factor(as.integer(properties$Trial))#
# Parse regions of interest (ROIs):#
lines <- properties$Line1#
properties$Line1 <- NULL#
words <- parse_lines(lines)#
#
properties <- data.frame(properties)#
colnames(properties) <- tolower(colnames(properties))#
list(tinfos=properties, #
markers=data.frame(markers),#
words=words)#
}#
#
extract_session_attributes <- function(messages) {#
#
msgs <- messages$msg#
attrs <- list()#
l <- which(msgs=="TRIAL_START")[[1]]#
msgs <- msgs[1:(l-1)]#
msgs <- strsplit(msgs, "[:;]")#
for (msg in msgs) {#
attrs[[msg[[1]]]] <- msg[-1]#
}#
#
pnames <- names(attrs)#
if ("Screen" %in% pnames)#
attrs$Screen <- as.numeric(attrs$Screen)#
if ("Font" %in% pnames)#
attrs$Font <- as.numeric(attrs$Font)#
if ("Pixel" %in% pnames)#
attrs$Pixel <- as.numeric(attrs$Pixel)#
if ("Version" %in% pnames)#
attrs$Version <- as.numeric(attrs$Version)#
if ("Monitor" %in% pnames) {#
t <- as.numeric(sub("[^1-9]+", "", attrs$Monitor))#
names(t) <- sub("[1-9]+", "", attrs$Monitor)#
attrs$Monitor <- t#
}#
if ("Distance" %in% pnames) {#
t <- as.numeric(sub("[^1-9]+", "", attrs$Distance))#
names(t) <- sub("[1-9]+", "", attrs$Distance)#
attrs$Distance <- t#
}#
if ("FinishDotX" %in% pnames) {#
attrs$FinishDot <- as.numeric(attrs$FinishDotX[-2])#
attrs$FinishDotX <- NULL#
}#
#
attrs#
}#
#
parse_lines <- function(lines) {#
#
lines <- substring(lines, 2)#
x <- strsplit(lines, "[:;]")#
x <- lapply(x, as.numeric)#
x1 <- lapply(x, function(x) x[seq(1,length(x), 4)])#
x2 <- lapply(x, function(x) x[seq(2,length(x), 4)])#
y2 <- lapply(x, function(x) x[seq(3,length(x), 4)])#
y1 <- lapply(x, function(x) x[seq(4,length(x), 4)])#
rid <- lapply(x, function(x) 1:(length(x)/4))#
trial <- lapply(1:length(x), function(i) rep(i, length(x[[i]])/4))#
#
data.frame(trial=unlist(trial), rid=unlist(rid), x1=unlist(x1),#
x2=unlist(x2), y1=unlist(y1), y2=unlist(y2))#
#
}#
#
# parse_lines.oldformat <- funtion(lines, height) {#
# #
#   # parse:#
#   x <- strsplit(lines, "(:[0-9]+;[0-9]+:)|(:[0-9]+$)|(^:1:)")#
#   y <- strsplit(lines, "(;[0-9]+:[0-9]+:)|(^:1:[0-9]+:)")#
# #
#   x <- lapply(x, function(x) as.numeric(x[-1]))#
#   y <- lapply(y, function(x) as.numeric(x[-1]))#
# #
#   x1 <- lapply(x, function(x) x[-length(x)])#
#   x2 <- lapply(x, function(x) x[-1])#
#   y1 <- lapply(y, function(x) x[-length(x)])#
#   y2 <- lapply(y, function(x) x[-1])#
# #
#   # create intervals:#
#   trial <- unlist(lapply(1:length(x1), function(i) rep(i, length(x1[[i]]))))#
#   rid <- unlist(lapply(1:length(x1), function(i) 1:length(x1[[i]])))#
#   d <- data.frame(trial=trial, rid=rid,#
#                   x1=unlist(x1), x2=unlist(x2),#
#                   y1=unlist(y1), y2=unlist(y2)+height)#
# #
#   # TODO: Label rows with text-junks.  #
# #
#   d#
#           #
# }
fix <- read.SMI.vasishthlab("/Users/felx/Dropbox/Workspace/gerda/rawdata/VP8_1286547 Samples.txt", xbuffer=2.5, ybuffer=50)
Reads eye tracking data from raw text files as provided by SMI's IDF#
# Converter 3.0.3.#
# TODO: Parse Session-specific properties.#
read.SMI.samples <- function(filename) {#
# TODO: Figure out at which line the records start.#
data <- read.table(filename, header=TRUE, skip=20, sep="\t", quote="",#
fill=TRUE, comment.char="", stringsAsFactors=FALSE)#
#
# Fix colnames:#
colnames(data) <- tolower(colnames(data))#
colnames(data)[4] <- "x"#
colnames(data)[5] <- "y"#
#
# Fix data types and remove unwanted data:#
# TEMP: Because I don't know what it's good for anyway, and I'd like to save#
# the memory:#
#data$trigger <- as.factor(data$trigger)#
data$trigger <- NULL#
data$type <- as.factor(data$type)#
#
# Split data into samples and messages:#
samples  <- data.frame(subset(data, type=="SMP"))#
samples$type <- NULL#
samples$x <- as.double(samples$x)#
#
return(samples)#
}#
#
read.SMI.messages <- function(filename) {#
data <- read.table(filename, header=TRUE, skip=20, sep="\t", quote="",#
fill=TRUE, comment.char="", stringsAsFactors=FALSE)#
#
# Fix colnames:#
colnames(data) <- tolower(colnames(data))#
colnames(data)[4] <- "x"#
colnames(data)[5] <- "y"#
#
# Fix data types and remove unwanted data:#
# TEMP: Because I don't know what it's good for anyway, and I'd like to save#
# the memory:#
#data$trigger <- as.factor(data$trigger)#
data$trigger <- NULL#
data$type <- as.factor(data$type)#
data$trial <- NULL                     # Trial information provided by the#
# tracker is not relevant.  We care#
# for the info provided by the#
# presentation program.#
#
messages <- data.frame(subset(data, type=="MSG"))#
messages$y <- NULL#
messages$type <- NULL#
messages$msg <- as.character(messages$x)#
messages$x <- NULL#
#
return(messages)#
}#
#
read.SMI.vasishthlab <- function(filename, xbuffer=0, ybuffer=40) {#
message("Reading samples ... ")#
samples <- read.SMI.samples(filename)#
samples$trial <- NULL                  # Trial information provided by the#
# tracker is not relevant.  We care#
# for the info provided by the#
# presentation program.#
message("  ", nrow(samples), " samples read")#
#
message("Reading trial information ... ")#
messages <- read.SMI.messages(filename)#
messages$msg <- substring(messages$msg, 12)#
#
# Build a data frame with trial-specific attributes:#
x <- extract_trial_attributes(messages)#
tinfos <- x$tinfos#
markers <- x$markers#
words <- x$words#
#
sinfos <- extract_session_attributes(messages)#
## Felix has included screen size info from SMI txt file#
message("  Screen size: ", sinfos$Screen[1], "x", sinfos$Screen[2]) ##
screen_size <- c(0,sinfos$Screen[1],0,sinfos$Screen[2]) ##
message("  ", nrow(tinfos), " trials identified")#
message("  ", nrow(words), " words found")#
#
message("Postprocessing samples ... ")#
# Add correct trial IDs (as given by the presentation software):#
samples <- label_trials(samples, tinfos, markers)#
#
# Removing samples that are in-between trials:#
t <- !is.na(samples$trial)#
samples <- subset(samples, t)#
message("  ", sum(t), " waste samples removed")#
# Trial as factor:#
samples$trial <- as.factor(samples$trial)#
tinfos$trial <- as.factor(tinfos$trial)#
#
## Felix has included screen size info from SMI txt file#
message("Detect fixations ... ")#
fixations <- detect_fixations(samples, tinfos, screen=screen_size) ##
fixations <- trim_trials(fixations, fix_start,#
markers$IMAGE_START, markers$IMAGE_STOP)#
message("  ", nrow(fixations), " fixations detected")#
#
message("Mapping fixations to ROIs ... ")#
fixations$rid <- map_fixations(fixations, words,#
xbuffer=xbuffer, ybuffer=ybuffer)#
message("  ", format(#
length(which(is.na(fixations$rid))) / nrow(fixations) * 100, digits=2),#
"% of the fixations were outside any word")#
#
fixations$fix_start <- fixations$fix_start / 1000#
fixations$fix_end <- fixations$fix_end / 1000#
fixations$dur <- fixations$dur / 1000#
#
print.summary(fixations)#
#
fixations #
# return(list(samples=samples,#
#             tinfos=tinfos,#
#             markers=markers,#
#             words=words,#
#             sinfos=sinfos))#
}#
#
# Label data with trial ids: The raw eyelink data already have a field with#
# trial ids.  However, there, a trial comprises of the whole run, inculding#
# eyemovements during presentation of the comprehension question.  The#
# presentation software sends signals that indicate the beginning and end of#
# the periods that are relevant for the experiment.  Using those we label the#
# trials.  The samples in-between those trials get NA as their trial id.#
# TODO: Add sanity checks, in particular: check if each START marker has a#
# correponding stop marker.#
label_trials <- function(samples, tinfos, markers) {#
samples$trial <- integer(nrow(samples))#
samples$trial <- NA#
ints <- Intervals(cbind(markers$TRIAL_START, markers$TRIAL_STOP))#
hits <- interval_overlap(ints, samples$time)#
for (i in 1:length(hits))#
samples$trial[hits[[i]]] <- tinfos$trial[[i]]#
#
samples#
}#
#
# Looks at the messages in the first trial (until TRIAL_STOP) and collects the#
# properties and markers that were sent by the presentation software during#
# that trial.  The assumption is that all trials have the same set of#
# properties and markers.#
extract_attribute_names <- function(messages) {#
msgs <- messages$msg#
properties <- c()#
markers <- c()#
i <- 1#
l <- length(msgs)#
while (msgs[i] != "TRIAL_START") i <- i + 1#
while (i <= l) {#
msg <- msgs[i]#
if (msg == "TRIAL_STOP") {#
markers <- c(markers, msg)#
# TODO: Put trial ids to markers.#
return(list(properties=properties, markers=markers))#
}#
msg <- strsplit(msg, ":")[[1]]#
if (length(msg) == 1)#
markers <- c(markers, msg)#
else#
properties <- c(properties, msg[1])#
i <- i + 1#
}#
# This should never happen, but anyway:#
warning("extract_attribute_names couldn't find TRIAL_STOP marker.")#
return(list(properties=properties, markers=markers))#
}#
#
# Returns a data frame containing a row for each trial and a column for every#
# porperty and marker.  Properties are name value pairs, a marker is just an#
# event with no further value, e.g. TRIAL_START.  The columns for the markers#
# list the times when they happened.#
extract_trial_attributes <- function(messages) {#
#
# TODO: ignore Calibration messages.#
#
attributes <- extract_attribute_names(messages)#
no_trials <- nrow(subset(messages, msg=="TRIAL_START"))#
#
# Create an appropriate data frame:#
properties <- list()#
markers <- list()#
for (property in attributes$properties) {#
properties[[property]] <- character(no_trials)#
}#
for (marker in attributes$markers) {#
markers[[marker]] <- double(no_trials)#
}#
#
# Now fill-in the values:#
msgs <- messages$msg#
time <- messages$time#
i <- 1#
l <- length(msgs)#
cur_trial <- 0                       # assuming that we always start with 1.#
while (msgs[i] != "TRIAL_START") i <- i + 1#
while (i <= l) {#
msg <- msgs[i]#
msg <- strsplit(msg, ":")[[1]]#
name <- msg[[1]]#
if (name == "TRIAL_START")#
cur_trial <- cur_trial + 1#
if (any(name == attributes$markers))#
markers[[name]][cur_trial] <- time[i]#
else {#
# TODO: save everything following the first colon:#
properties[[name]][cur_trial] <- substring(msgs[i], nchar(name)+2)#
}#
i <- i + 1#
}#
#
properties$Trial <- as.factor(as.integer(properties$Trial))#
# Parse regions of interest (ROIs):#
lines <- properties$Line1#
properties$Line1 <- NULL#
words <- parse_lines(lines)#
#
properties <- data.frame(properties)#
colnames(properties) <- tolower(colnames(properties))#
list(tinfos=properties, #
markers=data.frame(markers),#
words=words)#
}#
#
extract_session_attributes <- function(messages) {#
#
msgs <- messages$msg#
attrs <- list()#
l <- which(msgs=="TRIAL_START")[[1]]#
msgs <- msgs[1:(l-1)]#
msgs <- strsplit(msgs, "[:;]")#
for (msg in msgs) {#
attrs[[msg[[1]]]] <- msg[-1]#
}#
#
pnames <- names(attrs)#
if ("Screen" %in% pnames)#
attrs$Screen <- as.numeric(attrs$Screen)#
if ("Font" %in% pnames)#
attrs$Font <- as.numeric(attrs$Font)#
if ("Pixel" %in% pnames)#
attrs$Pixel <- as.numeric(attrs$Pixel)#
if ("Version" %in% pnames)#
attrs$Version <- as.numeric(attrs$Version)#
if ("Monitor" %in% pnames) {#
t <- as.numeric(sub("[^1-9]+", "", attrs$Monitor))#
names(t) <- sub("[1-9]+", "", attrs$Monitor)#
attrs$Monitor <- t#
}#
if ("Distance" %in% pnames) {#
t <- as.numeric(sub("[^1-9]+", "", attrs$Distance))#
names(t) <- sub("[1-9]+", "", attrs$Distance)#
attrs$Distance <- t#
}#
if ("FinishDotX" %in% pnames) {#
attrs$FinishDot <- as.numeric(attrs$FinishDotX[-2])#
attrs$FinishDotX <- NULL#
}#
#
attrs#
}#
#
parse_lines <- function(lines) {#
#
lines <- substring(lines, 2)#
x <- strsplit(lines, "[:;]")#
x <- lapply(x, as.numeric)#
x1 <- lapply(x, function(x) x[seq(1,length(x), 4)])#
x2 <- lapply(x, function(x) x[seq(2,length(x), 4)])#
y2 <- lapply(x, function(x) x[seq(3,length(x), 4)])#
y1 <- lapply(x, function(x) x[seq(4,length(x), 4)])#
rid <- lapply(x, function(x) 1:(length(x)/4))#
trial <- lapply(1:length(x), function(i) rep(i, length(x[[i]])/4))#
#
data.frame(trial=unlist(trial), rid=unlist(rid), x1=unlist(x1),#
x2=unlist(x2), y1=unlist(y1), y2=unlist(y2))#
#
}#
#
# parse_lines.oldformat <- funtion(lines, height) {#
# #
#   # parse:#
#   x <- strsplit(lines, "(:[0-9]+;[0-9]+:)|(:[0-9]+$)|(^:1:)")#
#   y <- strsplit(lines, "(;[0-9]+:[0-9]+:)|(^:1:[0-9]+:)")#
# #
#   x <- lapply(x, function(x) as.numeric(x[-1]))#
#   y <- lapply(y, function(x) as.numeric(x[-1]))#
# #
#   x1 <- lapply(x, function(x) x[-length(x)])#
#   x2 <- lapply(x, function(x) x[-1])#
#   y1 <- lapply(y, function(x) x[-length(x)])#
#   y2 <- lapply(y, function(x) x[-1])#
# #
#   # create intervals:#
#   trial <- unlist(lapply(1:length(x1), function(i) rep(i, length(x1[[i]]))))#
#   rid <- unlist(lapply(1:length(x1), function(i) 1:length(x1[[i]])))#
#   d <- data.frame(trial=trial, rid=rid,#
#                   x1=unlist(x1), x2=unlist(x2),#
#                   y1=unlist(y1), y2=unlist(y2)+height)#
# #
#   # TODO: Label rows with text-junks.  #
# #
#   d#
#           #
# }
fix <- read.SMI.vasishthlab("/Users/felx/Dropbox/Workspace/gerda/rawdata/VP8_1286547 Samples.txt", xbuffer=2.5, ybuffer=60)
install.packages("xtable")
install.packages("xtable", dependencies=T)
install.packages("lme4", dependencies=T)
install.packages("knitr", dependencies=T)
install.packages(c("gdata","reshape"), dependencies=T)
install.packages(c("em","ggplot2"), dependencies=T)
install.packages(c("car"), dependencies=T)
load('~/Dropbox/Workspace/rukshins data/allsubjects-left-etm.RData')
head(d)
head(d,20)
summary(d)
load('~/Dropbox/Workspace/rukshins data/allsubjects-right-fix.RData')
head(fix)
ls()
head(d)
summary(d)
str(d)
subset(d,item==22)
subset(d,item==23)
subset(d,item=="22")
subset(d,item=="23")
subset(d,item==2202)
library(saccades)
install.packages(intervals)
library(em)
?em
fixations <- read.table("~/Dropbox/Workspace/ACT-R_EMMA/PortedParserEMMA/output/e2-p140-r2-s0/fixations.txt")
head(fixations)
colnames(fixations)
colnames(fixations) <- c("exp","iteration","cond","pos","word","dur")
head(fixations)
library(knitr)
ls
?spin
dev.new(width=10, height=5)
dev.off()
dev.new(width=10, height=5)
dev.off()
remove(list=ls())#
#flush.console()#
#
setwd("~/Dropbox/Workspace/TopiCS/post-review-revision/data/scripts")#
#getwd()#
model <- "model-psc"#
file <- paste(getwd(),"..", model, "fixations.txt", sep="/")#
mfile <- paste(getwd(),"..", model, "m.RData", sep="/")#
#
source("functions.R")#
source("0-preprocess-fixations.R")#
source("1-generalfit.R")#
source("2-f-statistics.R")#
source("3-spu-statistics.R")#
source("4-rv100-statistics.R")#
#
m <- preprocess.fixations(file)#
load(mfile)#
(fstat <- freq.stat.all(m))#
mean(fstat["rmsd",])#
(gfit <- general.fit(m))#
(params <- extract.params(paste(getwd(),"..",model,"params.txt", sep="/")))#
(regtrials <- reg.trials(m))#
save(m,params,fstat,regtrials, file="m.RData")
m1 <- exclude.regressions(m)#
(fstat1 <- freq.stat.early(m1))#
save(m1,params,fstat1,regtrials, file="m1.RData")
remove(list=ls())#
#flush.console()#
#
setwd("~/Dropbox/Workspace/TopiCS/post-review-revision/data/scripts")#
#
source("functions.R")#
source("0-preprocess-fixations.R")#
source("1-generalfit.R")#
source("2-f-statistics.R")#
source("3-spu-statistics.R")#
source("4-rv100-statistics.R")#
#getwd()#
#model <- "model-psc-s"#
#file <- paste(getwd(),"..", model, "fixations.txt", sep="/")#
#mfile <- paste(getwd(),"..", model, "m.RData", sep="/")#
setwd("../model-psc/")#
file <- "fixations.txt"
load("m.RData")
(fstat <- freq.stat.all(m))
mean(fstat["rmsd",])#
#(gfit <- general.fit(m))#
(params <- extract.params()#
(regtrials <- reg.trials(m))#
save(m,params,fstat,regtrials, file="m.RData")
(params <- extract.params())#
(regtrials <- reg.trials(m))#
save(m,params,fstat,regtrials, file="m.RData")
m1 <- exclude.regressions(m)#
(fstat1 <- freq.stat.early(m1))#
save(m1,params,fstat1,regtrials, file="m1.RData")
setwd("../model-psc-s/")#
file <- "fixations.txt"#
#
#m <- preprocess.fixations(file)#
load("m.RData")#
(fstat <- freq.stat.all(m))#
mean(fstat["rmsd",])#
#(gfit <- general.fit(m))#
(params <- extract.params())#
(regtrials <- reg.trials(m))#
save(m,params,fstat,regtrials, file="m.RData")
setwd("../model-psc-r/")#
file <- "fixations.txt"#
#
#m <- preprocess.fixations(file)#
load("m.RData")#
(fstat <- freq.stat.all(m))#
mean(fstat["rmsd",])#
#(gfit <- general.fit(m))#
(params <- extract.params())#
(regtrials <- reg.trials(m))#
save(m,params,fstat,regtrials, file="m.RData")
setwd("../model-psc-rs/")#
file <- "fixations.txt"#
#
#m <- preprocess.fixations(file)#
load("m.RData")#
(fstat <- freq.stat.all(m))#
mean(fstat["rmsd",])#
#(gfit <- general.fit(m))#
(params <- extract.params())#
(regtrials <- reg.trials(m))#
save(m,params,fstat,regtrials, file="m.RData")
setwd("../model-psc-rsh/")#
file <- "fixations.txt"#
#
#m <- preprocess.fixations(file)#
load("m.RData")#
(fstat <- freq.stat.all(m))#
mean(fstat["rmsd",])#
#(gfit <- general.fit(m))#
(params <- extract.params())#
(regtrials <- reg.trials(m))#
save(m,params,fstat,regtrials, file="m.RData")
setwd("../model-psc-shr/")#
file <- "fixations.txt"#
#
#m <- preprocess.fixations(file)#
load("m.RData")#
(fstat <- freq.stat.all(m))#
mean(fstat["rmsd",])#
#(gfit <- general.fit(m))#
(params <- extract.params())#
(regtrials <- reg.trials(m))#
save(m,params,fstat,regtrials, file="m.RData")
setwd("../model-psc-sr/")#
file <- "fixations.txt"#
#
#m <- preprocess.fixations(file)#
load("m.RData")#
(fstat <- freq.stat.all(m))#
mean(fstat["rmsd",])#
#(gfit <- general.fit(m))#
(params <- extract.params())#
(regtrials <- reg.trials(m))#
save(m,params,fstat,regtrials, file="m.RData")
setwd("../model-psc-sh/")#
file <- "fixations.txt"#
#
#m <- preprocess.fixations(file)#
load("m.RData")#
(fstat <- freq.stat.all(m))#
mean(fstat["rmsd",])#
#(gfit <- general.fit(m))#
(params <- extract.params())#
(regtrials <- reg.trials(m))#
save(m,params,fstat,regtrials, file="m.RData")
