Merge pull request #6 from tombeesley/develop

Develop

.Rbuildignore

@@ -1,7 +1,11 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
-^fix_dispersion_old\.R$
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
 ^\.github$
+^vignettes/articles$
+^index\.Rmd$
+^_config\.yml$
+^README\.Rmd$
+^inst/extdata$

DESCRIPTION

@@ -1,25 +1,28 @@
 Type: Package
 Package: eyetools
-Title: Tools for eye data analysis
-Version: 0.6.1
+Title: Tools for Eye Data Analysis
+Version: 0.7.0
 Authors@R: c(
-    person("Beesley", "Tom", email = "t.beesley@lancaster.ac.uk", role = c("aut", "cre")),
-    person("Ivory", "Matthew", email = "matthew.ivory@lancaster.ac.uk", role = "aut"))
-Description: A set of tools for eye data processing. The intended flow is
-    from data processing, to fixation analysis, to data visualisation and
-    trial level summaries.
+    person("Beesley", "Tom", , "matthew.ivory@lancaster.ac.uk", role = c("aut", "cre")),
+    person("Ivory", "Matthew", , "matthew.ivory@lancaster.ac.uk", role = "aut")
+  )
+Description: A set of tools for easier eye data processing. 
+  It enables automation of actions across the pipeline starting from combining binocular data, repairing missing data, 
+  through to event-related processing (fixations, saccades, time in AOIs), to data visualisation. These tools take relatively raw (trial, time, x, and y form) data 
+  and can be used to return fixations, saccades, and AOI entries and time spent in AOIs. 
+  As the tools rely on this basic data format, the functions can work with data from any eye tracking device.
 License: GPL-3
+cph: Tom Beesley
+URL: https://tombeesley.github.io/eyetools/
 Depends: 
     R (>= 2.10)
 Imports: 
-    dplyr,
     ggforce,
     ggplot2,
     glue,
     hdf5r,
     lifecycle,
     magick,
-    magrittr,
     pbapply,
     rdist,
     rlang,
@@ -29,11 +32,13 @@ Imports:
 Suggests: 
     knitr,
     rmarkdown,
-    testthat (>= 3.0.0)
-VignetteBuilder: knitr
+    testthat (>= 3.0.0),
+    tidyverse
+VignetteBuilder: 
+    knitr
+Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
-URL: https://tombeesley.github.io/eyetools/
-Config/testthat/edition: 3
+Language: en-GB

NAMESPACE

@@ -14,15 +14,13 @@ export(plot_seq)
 export(plot_spatial)
 export(saccade_VTI)
 export(smoother)
-import(dplyr)
 import(ggforce)
 import(ggplot2)
 import(hdf5r)
 import(rlang)
 importFrom(glue,glue)
 importFrom(lifecycle,deprecated)
 importFrom(magick,image_read)
-importFrom(magrittr,"%>%")
 importFrom(pbapply,pblapply)
 importFrom(rlang,.data)
 importFrom(stats,aggregate)

NEWS.md

@@ -1,4 +1,13 @@
+# eyetools 0.7.0
+* added support for multi-participant data in most functions
+* standardised expected data input to functions
+* added optional parameter for proportion of time spent to AOI_time()
+* fixed smoother() span parameter
+* added plots to smoother()
+* improved handling of variable order in all functions
+
 # eyetools 0.6.1
+* added new functions: compare_algorithms(), conditional_transform(), fixation_VTI(), hdf5_to_csv()
 
 # eyetools 0.6.0
 

R/AOI_seq.R

@@ -1,63 +1,97 @@
 #' Sequence analysis of area of interest entries
 #'
-#' Analyses the sequence of entries into defined AOI regions across trials. Works with fixation data or raw data as the input.
+#' Analyses the sequence of entries into defined AOI regions across trials. Can only be used with fixation data with a "fix_n" column denoting fixation events.
 #'
-#' @param data A dataframe with fixation data (from fix_dispersion) or raw data.
+#'
+#' @param data A dataframe with fixation data (from fixation_dispersion). Either single or multi participant data
 #' @param AOIs A dataframe of areas of interest (AOIs), with one row per AOI (x, y, width_radius, height).
 #' @param AOI_names An optional vector of AOI names to replace the default "AOI_1", "AOI_2", etc.
 #' @param sample_rate Optional sample rate of the eye-tracker (Hz) for use with raw_data. If not supplied, the sample rate will be estimated from the time column and the number of samples.
 #' @param long Whether to return the AOI fixations in long or wide format. Defaults to long
-#' @return a long format dataframe containing the sequence of entries into AOIs on each trial
+#' @param participant_ID the variable that determines the participant identifier. If no column present, assumes a single participant
+#' @return a dataframe containing the sequence of entries into AOIs on each trial.
+#'
+#' If long is TRUE, then each AOI entry is returned on a new row, if FALSE, then a row per trial is returned with all AOI entries in one character string
 #' @export
 #'
 #' @examples
-#' fix_d <- fixation_dispersion(example_raw_WM)
-#' AOI_seq(fix_d, AOIs_WM)
+#' data <- combine_eyes(HCL)
+#' fix_d <- fixation_dispersion(data, participant_ID = "pNum")
+#'
+#' AOI_seq(fix_d, AOIs = HCL_AOIs, participant_ID = "pNum")
 #'
 #' @importFrom stats setNames complete.cases
 #' @importFrom utils stack
 
-AOI_seq <- function(data,
-                    AOIs,
-                    AOI_names = NULL,
-                    sample_rate = NULL,
-                    long = TRUE) {
+AOI_seq <- function(data, AOIs, AOI_names = NULL, sample_rate = NULL, long = TRUE, participant_ID = "participant_ID") {
 
-  # split data by trial
-  proc_data <- sapply(split(data, data$trial),
-                      AOI_seq_trial_process,
-                      AOIs = AOIs,
-                      AOI_names)
+  if(is.null(data[["fix_n"]])) stop("column 'fix_n' not detected. Are you sure this is fixation data from eyetools?")
 
-  data <- data.frame(trial = unique(data$trial),
-                     AOI_entry_seq = proc_data)
+  #first check for multiple/single ppt data
+  test <- .check_ppt_n_in(participant_ID, data)
+  participant_ID <- test[[1]]
+  data <- test[[2]]
 
-  if (long == TRUE) {
+  #internal_AOI_seq carries the per-participant functionality to be wrapped in the lapply for ppt+ setup
+  internal_AOI_seq <- function(data, AOIs, AOI_names, sample_rate, long) {
 
-    split_list <- strsplit(data$AOI_entry_seq,';')
 
-    split_list_names <- setNames(split_list, data$trial)
+    # split data by trial
+    proc_data <- sapply(split(data, data$trial),
+                        AOI_seq_trial_process,
+                        AOIs = AOIs,
+                        AOI_names)
 
-    data <- stack(split_list_names)
+    data <- data.frame(data[[participant_ID]][1],
+                       trial = unique(data$trial),
+                       AOI_entry_seq = proc_data)
 
-    data <- data.frame(trial = as.numeric(data$ind),
-           AOI = data$value)
+    colnames(data)[1] <- participant_ID #keep same column as entered
 
-# add in entry_n by way of indexing each trial
-get_row_n <- function(i) {
-  store <- data[data$trial == i,]
-  store$entry_n <- 1:nrow(store)
+    if (long == TRUE) {
 
-  store
-}
+      split_list <- strsplit(data$AOI_entry_seq,';')
 
-    data <- do.call(rbind.data.frame, lapply(1:max(data$trial), get_row_n))
+      split_list_names <- setNames(split_list, data$trial)
 
-  }
+      data_long <- stack(split_list_names)
+
+      data <- data.frame(participant_ID = data[[participant_ID]][1],
+                         trial = as.numeric(data_long$ind),
+                         AOI = data_long$value)
+
+      #keep original name
+      colnames(data)[1] <- participant_ID
+
+      # add in entry_n by way of indexing each trial
+      get_row_n <- function(i) {
+        store <- data[data$trial == i,]
+
+        if (nrow(store) == 0) { store <- NULL} else {
+          store$entry_n <- 1:nrow(store)}
 
+        store
+      }
 
-  return(data)
+      data <- do.call(rbind.data.frame, lapply(1:max(data$trial), get_row_n))
 
+      data <- data[data$AOI != "NA",] # remove rows that are NA
+    }
+    #RETURN THE DATA TO THE SAME FORMAT IF SINGLE PPT
+    if (data[[participant_ID]][1] == "NOT A VALID ID") data[[participant_ID]] <- NULL
+
+    return(data)
+
+      }
+
+  data <- split(data, data[[participant_ID]])
+  out <- lapply(data, internal_AOI_seq, AOIs, AOI_names, sample_rate, long)
+  out <- do.call("rbind.data.frame", out)
+  rownames(out) <- NULL
+
+  out <- .check_ppt_n_out(out)
+
+  return(out)
 }
 
 
@@ -73,7 +107,7 @@ AOI_seq_trial_process <- function(trial_data, AOIs, AOI_names) {
       # square AOI
       aoi_entries[,a] <- ((trial_data$x >= AOIs[a,1]-AOIs[a,3]/2 & trial_data$x <= AOIs[a,1]+AOIs[a,3]/2) &
                             (trial_data$y >= AOIs[a,2]-AOIs[a,4]/2 & trial_data$y <= AOIs[a,2]+AOIs[a,4]/2))
-      } else if (sum(!is.na(AOIs[a,])) == 3) {
+    } else if (sum(!is.na(AOIs[a,])) == 3) {
       # circle AOI
       aoi_entries[,a] <- sqrt((AOIs[a,1]-trial_data$x)^2+(AOIs[a,2]-trial_data$y)^2) < AOIs[a,3]
     } else {
@@ -87,15 +121,18 @@ AOI_seq_trial_process <- function(trial_data, AOIs, AOI_names) {
 
   # simplify to vector of AOI entries
   aoi_seq <- rowSums(aoi_entries)
-  aoi_seq <- aoi_seq[aoi_seq>0] # remove fixations without aoi hits
+  #aoi_seq <- aoi_seq[aoi_seq>0] # remove fixations without aoi hits
   find_repeat_entries <- c(TRUE, diff(aoi_seq)!=0)
   aoi_seq <- aoi_seq[find_repeat_entries]
+  aoi_seq <- aoi_seq[aoi_seq != 0] #remove non AOI fixations
 
   if (is.null(AOI_names)==FALSE) {
     aoi_seq <- paste0(AOI_names[aoi_seq], collapse = ";")
   } else {
     aoi_seq <- paste0(aoi_seq, collapse = ";")
   }
+
+
   return(aoi_seq)
 
 }