-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathAOI_time_binned.R
156 lines (115 loc) · 5.86 KB
/
AOI_time_binned.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
#' Binned time analysis of area of interest entries
#'
#' Analyses total time on defined AOI regions across trials separated into bins. Works with raw data as the input.
#' Data can be separated into bins of a given length of time and the number of bins per trial is calculated automatically, keeping the bin length
#' consistent across varying lengths of trial. Any r=data that cannot fill a bin (tpyically the last few milliseconds of the trial) are dropped to
#' ensure that bins are of a consistent length
#'
#' AOI_time_binned can take either single participant data or multiple participants where there is a variable for unique participant identification.
#' The function looks for an identifier named `participant_ID` by default and will treat this as multiple-participant data as default,
#' if not it is handled as single participant data, or the participant_ID needs to be specified
#'
#' @param data A dataframe of raw 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 data. If not supplied, the sample rate will be estimated from the time column and the number of samples.
#' @param bin_length the time duration to be used for each bin.
#' @param max_time maximum length of time to use, default is total trial length
#' @param as_prop whether to return time in AOI as a proportion of the total time of trial
#' @param participant_ID the variable that determines the participant identifier. If no column present, assumes a single participant
#'
#' @return a dataframe containing the time on the passed AOIs for each trial. One column for each AOI separated by trial.
#' @export
#'
#' @examples
#'
#' \donttest{
#' data <- combine_eyes(HCL)
#'
#'
#' #with bins of 100ms each and only for the first 2000ms
#' AOI_time_binned(data = data, AOIs = HCL_AOIs, participant_ID = "pNum",
#' bin_length = 100, max_time = 2000)
#' }
#'
AOI_time_binned <- function(data, AOIs, AOI_names = NULL, sample_rate = NULL, bin_length = NULL, max_time = NULL, as_prop = FALSE, participant_ID = "participant_ID") {
if(missing(bin_length)) stop("Requires bin_length")
#first check for multiple/single ppt data
test <- .check_ppt_n_in(participant_ID, data)
participant_ID <- test[[1]]
data <- test[[2]]
# dataframe to hold AOI entry results
# columns are trial, AOI time * number of AOIs
internal_AOI_time_binned <- function(data, AOIs, AOI_names, sample_rate, bin_length, max_time) {
ppt_label <- data[[participant_ID]][[1]]
# process as raw data input
proc_data <- lapply(split(data, data$trial),
AOI_binned_time_trial_process_raw,
AOIs = AOIs,
sample_rate = sample_rate,
bin_length,
max_time)
data <- do.call('rbind.data.frame', proc_data)
if (is.null(AOI_names)==FALSE) {
AOI_name_text <- c("trial", "bin_n", AOI_names)
} else {
AOI_name_text <- c("trial", "bin_n", sprintf("AOI_%s",1:nrow(AOIs)))
}
data <- cbind(ppt_label, data)
colnames(data) <- c(participant_ID, AOI_name_text)
return(data)
}
data <- split(data, data[[participant_ID]])
out <- lapply(data, internal_AOI_time_binned, AOIs, AOI_names, sample_rate, bin_length, max_time)
out <- do.call("rbind.data.frame", out)
rownames(out) <- NULL
out <- .check_ppt_n_out(out)
if (as_prop) {
#calculate prop
out[,4:ncol(out)] <- out[,4:ncol(out)]/bin_length
out[,4:ncol(out)][out[,4:ncol(out)] > 1] <- 1 #due to sample approximation, if over 1 then return to 1 as a value
out$bin_time <- NULL
}
return(out)
}
AOI_binned_time_trial_process_raw <- function(trial_data, AOIs, sample_rate, bin_length, max_time) {
if (is.null(sample_rate)==TRUE) sample_rate <- .estimate_sample_rate(trial_data)
sample_rate <- 1000/sample_rate
if (is.null(max_time)) max_time <- max(trial_data$time) #set as the total trial time
if(!is.null(bin_length)) {
time_ceil <- max_time/bin_length*bin_length
#split data into bins depending on the lengths given
trial_data$bin <- cut(trial_data$time,
# The breaks line cuts off any data over the final bin length, so all are of ~equal length when bin_length is used
breaks = c(-Inf, seq(0, time_ceil, bin_length)[-1]), #drop the starting 0 in favour of -Inf
label = FALSE)
data_bin <- split(trial_data, trial_data$bin)
}
data_binned <- split(trial_data, trial_data$bin)
AOI_bin_process <- function(trial_data, AOIs, sample_rate, bin_length, max_time) {
aoi_time_sums <- data.frame(matrix(nrow = 1, ncol = nrow(AOIs)))
for (a in 1:nrow(AOIs)) {
if (sum(!is.na(AOIs[a,])) == 4) {
# square AOI
xy_hits <- ((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) {
# circle AOI
xy_hits <- sqrt((AOIs[a,1]-trial_data$x)^2+(AOIs[a,2]-trial_data$y)^2) < AOIs[a,3]
} else {
# report error message of bad AOI definition
stop("Bad AOI definition")
}
# convert hits into data on time and entries
aoi_time_sums[a] <- round(sum(xy_hits*sample_rate,
na.rm = TRUE),0) # sum the valid AOI hits - multiply by sample rate
}
out <- data.frame(trial = trial_data$trial[1],
bin = trial_data$bin[1],
aoi_time_sums)
return(out)
}
data_out <- lapply(data_binned, AOI_bin_process, AOIs, sample_rate, bin_length, max_time)
data_out <- do.call('rbind.data.frame', data_out)
return(data_out)
}