version 0.1

DESCRIPTION

@@ -0,0 +1,20 @@
+Package: eyelinker
+Type: Package
+Title: Load Raw Data from Eyelink Eye Trackers
+Version: 0.1
+Date: 2016-04-20
+Author: Simon Barthelme <simon.barthelme@gipsa-lab.fr>
+Maintainer: Simon Barthelme <simon.barthelme@gipsa-lab.fr>
+Description: Eyelink eye trackers output a horrible mess, typically under
+    the form of a '.asc' file. The file in question is an assorted collection of
+    messages, events and raw data. This R package will attempt to make sense of it.
+Depends: R (>= 3.1.1)
+Imports: plyr, stringi, stringr, readr, magrittr, intervals
+License: GPL-3
+RoxygenNote: 5.0.1
+Suggests: testthat, knitr, rmarkdown, dplyr, ggplot2, tidyr
+VignetteBuilder: knitr
+NeedsCompilation: no
+Packaged: 2016-04-21 08:40:30 UTC; simon
+Repository: CRAN
+Date/Publication: 2016-04-21 13:46:06

MD5

@@ -0,0 +1,29 @@
+21fff75d4eb4716929805c7ee833faa8 *DESCRIPTION
+7c947ca65075255434eee20b85a82887 *NAMESPACE
+65c655fcc01d9fd99897174de98b399f *NEWS
+d089391679e71d51431e12a8a8cb5725 *R/eyelink_parser.R
+1f224b167e6cc3ae169ce5ff050b787b *R/eyelinker.R
+21e1b8dc55d1b80d471e37abf28abdf8 *R/utils.R
+122bddf6f5750cd71d3f7e82de3263e7 *README.md
+d088a1d5d3f928d301b704e891ad9856 *build/vignette.rds
+ae1733016a4b9601473cf601c5b105e3 *inst/doc/basics.R
+340eb8fed78fe5ee3f2036882e268689 *inst/doc/basics.Rmd
+f86e4bb7c763e468cb54982612cc25fa *inst/doc/basics.html
+3055e91f23a325149461179088886419 *inst/extdata/bino1000.asc.gz
+954fc81e01e6fa9fd276a689a374801c *inst/extdata/bino250.asc.gz
+b1286321a8d3523a0a8a2b3130626ec1 *inst/extdata/bino500.asc.gz
+89a9867f211f8e3715d756ad6a80f309 *inst/extdata/binoRemote250.asc.gz
+72afc20d1879cb6900d86d5247fa86ab *inst/extdata/binoRemote500.asc.gz
+9de823fb2cf9c9ad604db8beb609087c *inst/extdata/mono1000.asc.gz
+fb3bced1d12081489854149bd86d4cd5 *inst/extdata/mono2000.asc.gz
+ac382d6b1412800e3592889a99ba4b7c *inst/extdata/mono250.asc.gz
+959cef7777e00c175ffa184e550d1626 *inst/extdata/mono500.asc.gz
+10a60e755f1ab95fe8ed6128fc122e6f *inst/extdata/monoRemote250.asc.gz
+53a197bd5082342223ed07e3921c996b *inst/extdata/monoRemote500.asc.gz
+9d35809bc29fdaabf8f1f863190cff95 *man/eyelinker.Rd
+08ad84d62abde5a1dbba8ddda8d0e4ec *man/grapes-In-grapes.Rd
+e417bbd3aea2b21bef8f8cf99e5df3c0 *man/read.asc.Rd
+e99e311defffab95b01422825ee8365c *man/whichInterval.Rd
+0787363dcdb021acb16fadb40462fe41 *tests/testthat.R
+191586d478f0d7cf0e0a57c8a7b5338e *tests/testthat/test_examples.R
+340eb8fed78fe5ee3f2036882e268689 *vignettes/basics.Rmd

NAMESPACE

@@ -0,0 +1,23 @@
+# Generated by roxygen2: do not edit by hand
+
+export("%In%")
+export(read.asc)
+export(whichInterval)
+importFrom(intervals,Intervals)
+importFrom(intervals,distance_to_nearest)
+importFrom(intervals,which_nearest)
+importFrom(magrittr,"%>%")
+importFrom(plyr,dlply)
+importFrom(plyr,ldply)
+importFrom(plyr,llply)
+importFrom(plyr,mutate)
+importFrom(readr,read_tsv)
+importFrom(stringi,stri_enc_toascii)
+importFrom(stringr,fixed)
+importFrom(stringr,str_detect)
+importFrom(stringr,str_match)
+importFrom(stringr,str_replace)
+importFrom(stringr,str_replace_all)
+importFrom(stringr,str_split)
+importFrom(stringr,str_sub)
+importFrom(stringr,str_trim)

NEWS

@@ -0,0 +1,3 @@
+# eyelinker 0.1
+
+Initial CRAN release

R/eyelink_parser.R

@@ -0,0 +1,302 @@
+
+##' Read EyeLink ASC file
+##'
+##' ASC files contain raw data from EyeLink eyetrackers (they're ASCII versions of the raw binaries which are themselves in EDF format). 
+##' This utility tries to parse the data into something that's usable in R. Please read the EyeLink manual before using it for any serious work, very few checks are done to see if the output makes sense. 
+##' read.asc will return data frames containing a "raw" signal as well as event series. Events are either system signals (triggers etc.), which are stored in the "msg" field, or correspond to the Eyelink's interpretation of the eye movement traces (fixations, saccades, blinks). 
+##' ASC files are divided into blocks signaled by START and END signals. The block structure is reflected in the "block" field of the dataframes.
+##' If all you have is an EDF file, you need to convert it first using edf2asc from the Eyelink toolbox.
+##' The names of the various columns are the same as the ones used in the Eyelink manual, with two exceptions. "cr.info", which doesn't have a name in the manual, gives you information about corneal reflection tracking. If all goes well its value is just "..."
+##' "remote.info" gives you information about the state of the remote setup, if applicable. It should also be just a bunch of ... values. Refer to the manual for details. 
+##' @title Read EyeLink ASC file
+##' @param fname file name
+##' @return a list with components
+##' raw: raw eye positions, velocities, resolution, etc.
+##' msg: messages (no attempt is made to parse them)
+##' fix: fixations
+##' blinks: blinks
+##' sacc: saccades
+##' info: meta-data
+##' 
+##' @author Simon Barthelme
+##' @examples
+##' #Example file from SR research that ships with the package
+##' fpath <- system.file("extdata/mono500.asc.gz",package="eyelinker")
+##' dat <- read.asc(fpath)
+##' plot(dat$raw$time,dat$raw$xp,xlab="Time (ms)",ylab="Eye position along x axis (pix)")
+##' @export
+read.asc <- function(fname)
+    {
+        inp <- readLines(fname)
+
+        #Convert to ASCII
+        inp <- stri_enc_toascii(inp)
+
+        #Filter out empty lines, comments, trailing whitespace
+        inp <- str_select(inp,"^\\w*$",reverse=TRUE) %>% str_select("^#",reverse=TRUE) %>% str_select("^/",reverse=TRUE) %>% str_trim(side="right")
+
+        #Read meta-data from the "SAMPLES" line
+        info <- getInfo(inp)
+
+        #Just to spite us, there's an inconsistency in how HTARG info is encoded (missing tab)
+        #We fix it if necessary
+        if (info$htarg)
+        {
+            inp <- str_replace_all(inp,fixed("............."),fixed("\t............."))
+        }
+
+        #"Header" isn't strict, it's whatever comes before the first "START" line
+        init <- str_detect(inp,"^START") %>% which %>% min
+        header <- inp[1:(init-1)]
+        inp <- inp[init:length(inp)]
+
+
+        #Find blocks
+        bl.start <- str_detect(inp,"^START")%>%which
+        bl.end <- str_detect(inp,"^END")%>%which
+        nBlocks <- length(bl.start)
+        blocks <- llply(1:nBlocks,function(indB) process.block(inp[bl.start[indB]:bl.end[indB]],info))
+        collect <- function(vname)
+            {
+                valid <- Filter(function(ind) !is.null(blocks[[ind]][[vname]]),1:length(blocks))
+                ldply(valid,function(ind) mutate(blocks[[ind]][[vname]],block=ind))
+            }
+
+        list(raw=collect('raw'),msg=collect('msg'),sacc=collect('sacc'),fix=collect('fix'),blinks=collect('blinks'),info=info)
+    }
+
+
+
+process.block.header <- function(blk)
+    {
+        endh <- str_detect(blk,'^SAMPLES') %>% which
+        if (length(endh)!=1) stop('non-standard block header')
+        hd <-blk[1:endh]
+        #Parse  the EVENTS line 
+        ev <- str_select(hd,"^EVENTS")
+        regex.num <- "([-+]?[0-9]*\\.?[0-9]+)"
+        srate <-str_match(ev,paste0("RATE\t",regex.num))[,2] %>% as.numeric
+        tracking <-str_match(ev,"TRACKING\t(\\w+)")[,2]
+        filter <- str_match(ev,"FILTER\t(\\d)")[,2] %>% as.numeric
+        events <- list(left=str_detect(ev,fixed("LEFT")),
+                       right=str_detect(ev,fixed("RIGHT")),
+                       res=str_detect(ev,fixed(" RES ")),
+                       tracking=tracking,
+                       srate=srate,
+                       filter=filter)
+
+        #Now do the same thing for the SAMPLES line
+        sm <- str_select(hd,"^SAMPLES")
+
+        srate <-str_match(sm,paste0("RATE\t",regex.num))[,2] %>% as.numeric
+        tracking <-str_match(sm,"TRACKING\t(\\w+)")[,2]
+        filter <- str_match(sm,"FILTER\t(\\d)")[,2] %>% as.numeric
+
+        samples <- list(left=str_detect(sm,fixed("LEFT")),
+                        right=str_detect(sm,fixed("RIGHT")),
+                        res=str_detect(ev,fixed(" RES ")),
+                        vel=str_detect(ev,fixed(" VEL ")),
+                        tracking=tracking,
+                        srate=srate,
+                        filter=filter)
+
+        list(events=events,samples=samples,the.rest=blk[-(1:endh)])
+    }
+
+#Turn a list of strings with tab-separated field into a data.frame
+tsv2df <- function(dat)
+    {
+        if (length(dat)==1)
+            {
+                dat <- paste0(dat,"\n")
+            }
+        else
+            {
+                dat <- paste0(dat,collapse="\n")
+            }
+        out <- read_tsv(dat,col_names=FALSE)
+        if (!(is.null(attr(suppressWarnings(out), "problems")))) browser()
+        out
+    }
+
+parse.saccades <- function(evt,events)
+    {
+        #Focus only on EFIX events, they contain all the info
+        esac <- str_select(evt,"^ESAC") %>% str_replace("ESACC\\s+(R|L)","\\1\t") %>% str_replace_all("\t\\s+","\t")  
+        #Missing data
+        esac <- str_replace_all(esac,"\\s\\.","\tNA")
+
+        df <- str_split(esac,"\n") %>% ldply(function(v) { str_split(v,"\\t")[[1]] })
+        #Get a data.frame
+        if (ncol(df)==10)
+            {
+                #ESACC  <eye>  <stime>  <etime>  <dur> <sxp>  <syp>  <exp>  <eyp>  <ampl> <pv> 
+                names(df) <- c("eye","stime","etime","dur","sxp","syp","exp","eyp","ampl","pv")
+
+            }
+        else if (ncol(df)==12)
+            {
+                names(df) <- c("eye","stime","etime","dur","sxp","syp","exp","eyp","ampl","pv","xr","yr")
+            }
+
+        dfc <- suppressWarnings(llply(as.list(df)[-1],as.numeric) %>% as.data.frame )
+        dfc$eye <- df$eye
+        dfc
+    }
+
+
+
+parse.blinks <- function(evt,events)
+    {
+        eblk <- str_select(evt,"^EBLINK") %>% str_replace("EBLINK\\s+(R|L)","\\1\t") %>% str_replace_all("\t\\s+","\t") 
+        #Get a data.frame
+        #eblk <- eblk %>% tsv2df
+        df <- str_split(eblk,"\n") %>% ldply(function(v) { str_split(v,"\\t")[[1]] })
+        names(df) <- c("eye","stime","etime","dur")
+        dfc <- suppressWarnings(llply(as.list(df)[-1],as.numeric) %>% as.data.frame )
+        dfc$eye <- df$eye
+        dfc
+    }
+
+
+
+parse.fixations <- function(evt,events)
+    {
+        #Focus only on EFIX events, they contain all the info
+        efix <- str_select(evt,"^EFIX") %>% str_replace("EFIX\\s+(R|L)","\\1\t") %>% str_replace_all("\t\\s+","\t") 
+        #Get a data.frame
+                                        #efix <- efix %>% tsv2df
+        df <- str_split(efix,"\n") %>% ldply(function(v) { str_split(v,"\\t")[[1]] })
+        if (ncol(df)==7)
+            {
+                names(df) <- c("eye","stime","etime","dur","axp","ayp","aps")
+            }
+        else if (ncol(df)==9)
+            {
+                names(df) <- c("eye","stime","etime","dur","axp","ayp","aps","xr","yr")
+            }
+        dfc <- suppressWarnings(llply(as.list(df)[-1],as.numeric) %>% as.data.frame )
+        dfc$eye <- df$eye
+        dfc
+    }
+
+#evt is raw text, events is a structure with meta-data from the START field
+process.events <- function(evt,events)
+    {
+        #Messages
+        if (any(str_detect(evt,"^MSG")))
+        {
+            msg <- str_select(evt,"^MSG") %>% str_sub(start=5) %>% str_match("(\\d+)\\s(.*)") 
+            msg <- data.frame(time=as.numeric(msg[,2]),text=msg[,3])
+        }
+        else
+        {
+            msg <- c()
+        }
+
+        fix <- if (str_detect(evt,"^EFIX") %>% any) parse.fixations(evt,events) else NULL
+        sacc <- if (str_detect(evt,"^ESAC") %>% any) parse.saccades(evt,events) else NULL
+        blinks <- if (str_detect(evt,"^SBLI") %>% any) parse.blinks(evt,events) else NULL
+        list(fix=fix,sacc=sacc,msg=msg,blinks=blinks)
+    }
+
+
+#A block is whatever one finds between a START and an END event
+process.block <- function(blk,info)
+    {
+        hd <- process.block.header(blk)
+        blk <- hd$the.rest
+        raw.colnames <- coln.raw(info)
+
+        #Get the raw data (lines beginning with a number)
+        which.raw <- str_detect(blk,'^\\d')
+        raw <- blk[which.raw] %>% str_select('^\\d') # %>% str_replace(fixed("\t..."),"")
+#        raw <- str_replace(raw,"\\.+$","")
+
+        #Filter out all the lines where eye position is missing, they're pointless and stored in an inconsistent manner
+        iscrap <- str_detect(raw,"^\\d+\\s+\\.")
+        crap <- raw[iscrap]
+        raw <- raw[!iscrap]
+
+        #Turn into data.frame
+        raw <- tsv2df(raw)
+        names(raw) <- raw.colnames
+        nCol <- ncol(raw)
+        if (any(iscrap))
+            {
+                crapmat <- matrix(NA,length(crap),nCol)
+                crapmat[,1] <- as.numeric(str_match(crap,"^(\\d+)")[,1])
+                crapmat <- as.data.frame(crapmat)
+                names(crapmat) <- raw.colnames
+                raw <- rbind(raw,crapmat)
+                raw <- raw[order(raw$time),]
+            }
+
+        #The events (lines not beginning with a number)
+        evt <- blk[!which.raw]
+        res <- process.events(evt,hd$events)
+        res$raw <- raw
+        res$sampling.rate <- hd$events$srate
+        res$left.eye <- hd$events$left
+        res$right.eye <- hd$events$right
+        res
+    }
+
+#Read some meta-data from the SAMPLES line
+#Inspired by similar code from cili library by Ben Acland
+getInfo <- function(inp)
+{
+    info <- list()
+                                        #Find the "SAMPLES" line
+    l <- str_select(inp,"^SAMPLES")[[1]]
+    info$velocity <- str_detect(l,fixed("VEL"))
+    info$resolution <- str_detect(l,fixed("RES"))
+    #Even in remote setups, the target information may not be recorded 
+    #e.g.: binoRemote250.asc
+    #so we make sure it actually is
+    info$htarg <- FALSE
+    if (str_detect(l,fixed("HTARG")))
+    {
+        info$htarg <- str_detect(inp,fixed(".............")) %>% any
+    }
+    info$input <- str_detect(l,fixed("INPUT"))
+    info$left <- str_detect(l,fixed("LEFT"))
+    info$right <- str_detect(l,fixed("RIGHT"))
+    info$cr <- str_detect(l,fixed("CR"))
+    info$mono <- !(info$right & info$left)
+    info
+}
+
+#Column names for the raw data
+coln.raw <- function(info)
+{
+    eyev <- c("xp","yp","ps")
+    if (info$velocity)
+    {
+        eyev <- c(eyev,"xv","yv")
+    }
+    if (info$resolution)
+    {
+        eyev <- c(eyev,"xr","yr")
+    }
+
+    if (!info$mono)
+    {
+        eyev <- c(paste0(eyev,"l"),paste0(eyev,"r"))
+    }
+
+    #With corneal reflections we need an extra column
+    if (info$cr)
+    {
+        eyev <- c(eyev,"cr.info")
+    }
+
+    #Three extra columns for remote set-up
+    if (info$htarg)
+    {
+        eyev <- c(eyev,"tx","ty","td","remote.info")
+    }
+
+
+    c("time",eyev)
+}