-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathAOI_time.R
196 lines (141 loc) · 6.87 KB
/
AOI_time.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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
#' Time analysis of area of interest entries
#'
#' Analyses total time on defined AOI regions across trials. Works with fixation and raw data as the input (must use one or the other, not both).
#'
#' AOI_time 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 either fixation data (from fix_dispersion) or raw data
#' @param data_type Whether data is a fixation ("fix") or raw data ("raw")
#' @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 as_prop whether to return time in AOI as a proportion of the total time of trial
#' @param trial_time needed if as_prop is set to TRUE. a vector of the time taken in each trial. Equal to the length of x trials by y participants in the dataset
#' @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
#'
#' @importFrom utils stack
#' @examples
#'
#' \donttest{
#' data <- combine_eyes(HCL)
#' fix_d <- fixation_dispersion(data, participant_ID = "pNum")
#'
#' # fixation data
#' AOI_time(data = fix_d, data_type = "fix", AOIs = HCL_AOIs, participant_ID = "pNum")
#'
#' #raw data
#' AOI_time(data = data, data_type = "raw", AOIs = HCL_AOIs, participant_ID = "pNum")
#'
#' #as proportional data
#' AOI_time(data = fix_d, data_type = "fix", AOIs = HCL_AOIs, participant_ID = "pNum",
#' as_prop = TRUE, trial_time = HCL_behavioural$RT)
#'}
AOI_time <- function(data, data_type = NULL, AOIs, AOI_names = NULL, sample_rate = NULL, as_prop = FALSE, trial_time = NULL, participant_ID = "participant_ID") {
#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 <- function(data, data_type, AOIs, AOI_names, sample_rate) {
if (is.null(data_type) == TRUE) {
# input data for both fixations and raw data
stop("Type of data not specified. Use `data_type = 'fix'` for fixations or `data_type = 'raw'` for raw data")
} else if (data_type == "fix") {
ppt_label <- data[[participant_ID]][[1]]
# process as fixation data input
proc_data <- sapply(split(data, data$trial),
AOI_time_trial_process_fix,
AOIs = AOIs)
data <- cbind(unique(data$trial), t(proc_data))
} else if(data_type == "raw") {
ppt_label <- data[[participant_ID]][[1]]
# process as raw data input
proc_data <- sapply(split(data, data$trial),
AOI_time_trial_process_raw,
AOIs = AOIs,
sample_rate = sample_rate)
data <- cbind(unique(data$trial), t(proc_data))
}
if (is.null(AOI_names)==FALSE) {
AOI_name_text <- AOI_names
} else {
AOI_name_text <- sprintf("AOI_%s",1:nrow(AOIs))
}
data <- data.frame(data)
data <- do.call(cbind.data.frame, lapply(1:length(colnames(data)), function(i) {
data[,i] <- as.numeric(data[,i])
return(data[,i])
}))
colnames(data) <- c("trial", AOI_name_text)
trial <- data$trial
long_data <- stack(data, select = -trial)
long_data <- cbind(rep(data$trial, length(AOI_name_text)), long_data)
long_data <- cbind(ppt_label, long_data)
colnames(long_data) <- c(participant_ID, "trial", "time", "AOI")
return(long_data)
}
data <- split(data, data[[participant_ID]])
out <- lapply(data, internal_AOI_time, data_type, AOIs, AOI_names, sample_rate)
out <- do.call("rbind.data.frame", out)
rownames(out) <- NULL
out <- .check_ppt_n_out(out)
if (as_prop) {
if (length(trial_time) != nrow(out)/nrow(AOIs)) stop(paste("trial_time is not equal to the number of trials * participants in the data. Expected", nrow(out)/nrow(AOIs), "trial_time observations. Received", length(trial_time)))
trial_time <- data.frame(trial_time)
trial_time <- trial_time[rep(seq_len(nrow(trial_time)), each = nrow(AOIs)), ]
out <- out[order(out$pNum, out$trial),]
out$trial_time <- trial_time
out$time <- out$time/out$trial_time
out$trial_time <- NULL
rownames(out) <- NULL
}
#reorder
out <- out[, c(participant_ID, "trial", "AOI", "time")]
return(out)
}
AOI_time_trial_process_fix <- function(trial_data, AOIs) {
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 >= as.numeric(AOIs[a,1] - AOIs[a,3]/2) & trial_data$x <= as.numeric(AOIs[a,1] + AOIs[a,3]/2)) &
(trial_data$y >= as.numeric(AOIs[a,2] - AOIs[a,4]/2) & trial_data$y <= as.numeric(AOIs[a,2] + AOIs[a,4]/2))
} else if (sum(!is.na(AOIs[a,])) == 3) {
# circle AOI
xy_hits <- sqrt(as.numeric(AOIs[a,1]-trial_data$x)^2+as.numeric(AOIs[a,2]-trial_data$y)^2) < as.numeric(AOIs[a,3])
} else {
# report error message of bad AOI definition
}
# convert hits into data on time and entries
aoi_time_sums[a] <- sum(xy_hits*trial_data$dur) # sum the valid AOI hits
}
return(aoi_time_sums)
}
AOI_time_trial_process_raw <- function(trial_data, AOIs, sample_rate) {
if (is.null(sample_rate)==TRUE) sample_rate <- .estimate_sample_rate(trial_data)
sample_rate <- 1000/sample_rate
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
}
return(aoi_time_sums)
}