fix_align <- (start_pts,
asc_files = '.',
xy_bounds = ,
keep_y_var = ,
use_run_rule = ,
trial_plots = ,
save_trial_plots = ,
summary_file = ,
show_image = ,
fa_dir = 'FA_Dir',
start_flag = 'TRIALID',
den_sd_cutoff = ,
den_ratio_cutoff = 1,
k_bounds = (-.1, .1),
o_bounds = (-50, 50),
s_bounds = (1, 20)) {
# start_pts: n (number lines) x 2 matrix of c(x, y) for start point of each line
# asc_files: A vector of folders containing asc files and asc file names
# xy_bounds: c(x_min, x_max, y_min, y_max) or
# N (number trials) x 4 (x_min, x_max, y_min, y_max) matrix
# for which points to keep, if NULL, no bounds.
# keep_y_var: Keep variability in y around the line
# use_run_rule: If a series of ambiguous pts are bounded by points in the same
# category, classify the ambiguous points into that category.
# trial_plots: Show trial-by-trial plots.
# save_trial_plots: Save the trial plots as a tiff?
# summary_file: Output summary file.
# show_image: Show background images on trial plots.
# Images are tiffs in same directory as data (<sub>.asc)
# named <sub>.tiff (1 per subject) or <sub>_<trial#>.tiff (1 per subject per trial).
# fa_dir: Where to store the reformatted asc files
# start_flag: what text starts the trial in the asc file?
# den_sd_cutoff: remove points for which the density is > this many sd away
# from mean density
# den_ratio_cutoff: remove points for which (max density)/(2nd max density)
# not high enough
# k_bounds: c(min, max) for line slope, if NULL, set to default (0)
# o_bounds: c(min, max) for vertical line offset, if NULL, set to default (0)
# s_bounds: c(min, max) for line sd
# In fa.asc file
# -1000 = not in trial ('nit', fixation ends before start_flag)
# -1001 = partial fixation ('part', fixation started before start_flag, but ends after)
# -1002 = out-of-bounds fixation ('oob')
# -1003 = ambiguous fixation ('amb')
# -1004 = low-density fixation ('den')
# Andrew L. Cohen
# July 19, 2012
# © 2012
# University of Massachusetts
# All Rights Reserved
# fix_align.R v0.91
# Version notes:
# 0.90 - Original
# 0.91 - 11/28/12 alc
# Handles situations where two trials starts are not separated by a trial end or
# two fixation starts are not separated by a fixation end.
# 0.92 - 2/21/14 alc
# Inserts windows line breaks in the output file.
# Determine the names of the data files
##files <- get_file_names(asc_files)
<- asc_files
# Name of output file based on time and date
# fas: (f)ix_(a)lign (s)ummary
if (summary_file) {
out_file_name <-
(fa_dir, '/', ('\\s+', '_', ((), = '%B %d %Y')), '.fas', sep =
'')
out_file <- (out_file_name, 'w')
(
'File Trial Slope VOffset SD Fit n_total_fix n_keep n_oob n_amb n_den n_nit n_part\n',
= out_file
)
}
# The number of files to process
n_files <- ()
# Go through the files
for (i 1:n_files) {
# To keep track of progress
(('Processing: ', [i], sep = ""))
# Read in the asc_file
##asc_data <- read_asc_file(files[i], start_flag)
asc_data <- read_fix_report(asc_files)
# Initialize list
line_ret <- ()
# Go through the trials
n_trials <- asc_data$n_trials
for ( 1:n_trials) {
# Get the data for this trial
fix_data_trial <- asc_data$fix_data[t]]
# Mark out-of-bound fixations
fix_data_trial <-
mark_out_of_bounds(fix_data_trial, xy_bounds, , n_trials)
# Find the best-fitting lines
line_ret[t]] <- fit_lines(
start_pts[t]],
fix_data_trial,
keep_y_var,
use_run_rule,
k_bounds,
o_bounds,
s_bounds,
den_sd_cutoff,
den_ratio_cutoff
)
# Trial plots
if (trial_plots)
do_trial_plots(
line_ret[t]],
,
[i],
asc_data$dur_summary,
show_image,
save_trial_plots,
fa_dir
)
}
# Write the updated asc_file
##write_asc_file(line_ret, files[i], n_trials, fa_dir, start_flag, asc_data)
# Save summary
if (summary_file)
save_summary(line_ret, [i], out_file, n_trials)
}
# Close the summary file
if (summary_file)
(out_file)
(line_ret)
}
##############################
# get_file_names
##############################
get_file_names <- (asc_files) {
# The number of entries in the vector
n_entries <- (asc_files)
# Initialize variables
<- ( = 'character')
# Go through each entry
for (i 1:n_entries) {
# Get an asc entry
asc_entry <- asc_files[i]
# Determine if it is a directory or vector of files
is_dir <- (asc_entry)$isdir
# If it doesn't exist, change to false, it could be missing '.asc'
if ((is_dir))
is_dir <-
# Folders
if (is_dir) {
# Make sure there is a / at the end of the folder name
if ((asc_entry, (asc_entry), (asc_entry)) != '/')
asc_entry <- (asc_entry, '/', sep = '')
<- (, (asc_entry,
(
path = asc_entry, = '*.asc'
),
sep = ''))
# File or doesn't exist
} {
# Delete and paste '.asc' to the end
asc_entry <-
(('.asc', '', asc_entry, fixed = ), '.asc', sep = '')
# Determine if the file exists
file_exists <- (asc_entry)
# Not found
if (file_exists)
<- (, asc_entry)
('ASC file/folder ', asc_entry, ' not found.')
}
}
# If no valid entries found
if (() == 0)
('No valid ASC files/folders found.')
# Get rid of duplicates
<- ()
# Return the vector of files to process
()
}
##############################
# read_asc_file
##############################
read_asc_file <- (asc_file_name, start_flag) {
# Constants
col_range <- 5:8
# Read in the file
f <- (asc_file_name)
# Get trial start and end
trial_id_start <- (('TRIALID', f))
trial_start <- ((start_flag, f))
trial_end <- (('END', f)) # -----------------------------------------> modified from 'TRIAL_RESULT'
# Handle situations where two trials starts are not
# separated by trial ends (e.g., due to aborted trials).
# Get rid of first one.
# Get rid of errant TRIALIDs
marked_starts <- ()
start_index <- 1
end_index <- 1
while (start_index < (trial_id_start)) {
if (trial_id_start[start_index + 1] < trial_end[end_index]) {
marked_starts <- (marked_starts, start_index)
} {
end_index <- end_index + 1
}
start_index <- start_index + 1
}
if ((marked_starts) > 0)
trial_id_start <- trial_id_start-marked_starts]
# Get rid of errant start_flags
marked_flags <- ()
flag_index <- 1
end_index <- 1
while (flag_index < (trial_id_start)) {
if (trial_start[flag_index + 1] < trial_end[end_index]) {
marked_flags <- (marked_flags, flag_index)
} {
end_index <- end_index + 1
}
flag_index <- flag_index + 1
}
if ((marked_flags) > 0)
trial_start <- trial_start-marked_flags]
# Number of trials
n_trials <- (trial_start)
# Initialize fixation data
fix_data <- ()
# Keep duration data in a vector to get summary info
all_dur <- (0)
# Analyze each trial
for ( 1:n_trials) {
# Data for one trial
trial_data <- f[trial_id_start[t]:trial_end[t]]
# Find the start and end of the fixations
trial_start_fix <- (('SFIX', trial_data))
trial_end_fix <- (('EFIX', trial_data))
# Handle situations where two start fixations are not
# separated by end fixations (e.g., due to track loss).
# Get rid of first one.
marked_starts <- ()
start_index <- 1
end_index <- 1
while (start_index < (trial_start_fix)) {
if (trial_start_fix[start_index + 1] < trial_end_fix[end_index]) {
marked_starts <- (marked_starts, start_index)
} {
end_index <- end_index + 1
}
start_index <- start_index + 1
}
trial_start_fix <- trial_start_fix-marked_starts]
# Fixations for a trial and get rid of extra white space
trial_fix <- trial_data[trial_end_fix]
trial_fix <- ('\\s+', ' ', trial_fix)
trial_fix <- (trial_fix, ' ')
# Fixation duration, location, pupil size
n_fix <- (trial_fix)
# n_fixations x 4 (duration, x, y, pupil_size)
fix_data_trial <- (, = n_fix, = 4)
for (i 1:n_fix) {
fix_data_trial[i, 1:4] <- (trial_fix[i]][col_range])
}
fix_data_trial <- (fix_data_trial)
(fix_data_trial) <- ('dur', 'x', 'y', 'pupil')
# Originally mark all fixations as keepers
fix_data_trial$ = 'keep'
# Mark any fixations before the start flag as not in trial (NIT)
fix_data_trial$[trial_end_fix < (trial_start[t] - trial_id_start[t] + 1)] <-
'nit'
# Find the first full fixation after the start flag, mark others as partial (part)
fix_data_trial$[trial_start_fix < (trial_start[t] - trial_id_start[t] + 1) &
trial_end_fix > (trial_start[t] - trial_id_start[t] + 1)] <-
'part'
# Store duration information
all_dur <- (all_dur, fix_data_trial$dur)
fix_data[t]] <- fix_data_trial
}
# Put all data together in one list
asc_data <- ()
asc_data$fix_data <- fix_data
asc_data$n_trials <- n_trials
asc_data$dur_summary <- (all_dur)
asc_data$trial_id_start <- trial_id_start
asc_data$trial_start <- trial_start
asc_data$trial_end <- trial_end
(asc_data)
}
##############################
# mark_out_of_bounds
##############################
mark_out_of_bounds <-
(fix_data_trial, xy_bounds, , n_trials) {
# If we use bounds
if (!(xy_bounds)) {
# Bounds for this trial
if (((xy_bounds)) || (xy_bounds) == 1)
xy_bounds_trial <- xy_bounds
{
# Make sure there are enough xy_bounds entries
if ((xy_bounds) != n_trials)
('Length of xy_bounds doesn\'t match number of trials.')
xy_bounds_trial <- xy_bounds[t, ]
}
# Mark out-of-bounds fixations
x_keepers <-
fix_data_trial$x > xy_bounds_trial[1] &
fix_data_trial$x < xy_bounds_trial[2]
y_keepers <-
fix_data_trial$y > xy_bounds_trial[3] &
fix_data_trial$y < xy_bounds_trial[4]
# Give partial & not in trial fixations priority for marking
nit <- fix_data_trial$ == 'nit'
part <- fix_data_trial$ == 'part'
# Mark as out-of-bounds
fix_data_trial$!(x_keepers &
y_keepers) & !part & !nit] <- 'oob'
}
# Return it
(fix_data_trial)
}
##############################
# fit_lines
##############################
fit_lines <- (start_pts,
fix_data_trial,
keep_y_var,
use_run_rule,
k_bounds,
o_bounds,
s_bounds,
den_sd_cutoff,
den_ratio_cutoff) {
# Intitial parameter values (slope, vertical offset, sd)
init_params = (0, 0, 0)
# Find the best fitting parameters
fit <- (
init_params,
create_lines,
fix_data = fix_data_trial,
start_pts = start_pts,
k_bounds = k_bounds,
o_bounds = o_bounds,
s_bounds = s_bounds
)
# Rerun to get additional information
line_ret <- create_lines(
fit$,
fit_it = ,
start_pts = start_pts,
fix_data = fix_data_trial,
keep_y_var = keep_y_var,
use_run_rule = use_run_rule,
den_sd_cutoff = den_sd_cutoff,
den_ratio_cutoff = den_ratio_cutoff,
k_bounds = k_bounds,
o_bounds = o_bounds,
s_bounds = s_bounds
)
# Return
(line_ret)
}
##############################
# create_lines
##############################
create_lines <- (params,
fix_data,
start_pts,
k_bounds,
o_bounds,
s_bounds,
fit_it = ,
keep_y_var,
use_run_rule,
den_sd_cutoff,
den_ratio_cutoff) {
# fit_it: TRUE -> return fit measure, FALSE -> return fit information
# den_sd_cutoff: remove points for which the density is > this many sd away from mean density
# den_ratio_cutoff: remove points for which (max density)/(2nd max density) not high enough
# Unpack the parameters
if ((k_bounds))
k <- 0
k <- k_bounds[1] + (k_bounds[2] - k_bounds[1]) * (params[1])
if ((o_bounds))
o <- 0
o <- o_bounds[1] + (o_bounds[2] - o_bounds[1]) * (params[2])
s <- s_bounds[1] + (s_bounds[2] - s_bounds[1]) * (params[3])
# The y-values for the lines
ys <- start_pts, 2]
# The number of clusters is based off of the lines
n_clusters <- (ys)
# Initialize some matrices
data_den <- ((0), (fix_data), n_clusters)
y_diff <- ((0), (fix_data), n_clusters)
for (l 1:n_clusters) {
# The value of each point on each line
y_on_line <- o + k * (fix_data$x - start_pts[l, 1]) + start_pts[l, 2]
# Log density value for each point based on the line and sd
data_den, l] <- ((fix_data$y, = y_on_line, = s))
# Store the difference between the real and fitted value
y_diff, l] <- fix_data$y - y_on_line
}
# Find max density line for each point
# Assume all-or-none classification
data_den_max <- (data_den, 1, )
# The sum of the log densitities is the fit measure
# Only use valid, in-bounds fixations
fit_measure <- -(data_den_max[fix_data$ == 'keep'])
if (fit_it) {
# In case log density goes to infinity
if (fit_measure == )
fit_measure = $integer.max
# Return the fit measure
(fit_measure)
} {
# Mark ambigous points
data_den_sort <- (((data_den), 1, ))
data_den_ratio <-
data_den_sort, n_clusters] / data_den_sort, n_clusters - 1]
ambig_rm <- data_den_ratio < den_ratio_cutoff
ambig_rm <-
ambig_rm & fix_data$ != 'oob' & fix_data$ != 'part' &
fix_data$ != 'nit'
fix_data$[ambig_rm] <- 'amb'
# Mark points with very low density
inv_dnorm <- (x) {
(-2 * ((2 * ) * x))
}
density_rm <-
inv_dnorm((data_den_max)) > den_sd_cutoff
# Old way to remove outliers
#density_rm <-
# data_den_max < (mean(data_den_max) - den_sd_cutoff*sd(data_den_max))
density_rm <-
density_rm & fix_data$ != 'oob' & fix_data$ != 'amb' &
fix_data$ != 'part' & fix_data$ != 'nit'
fix_data$[density_rm] <- 'den'
# Category membership
cats <- (data_den, 1, )
fix_data$ <- cats
# Reclassify ambiguous pts based on surrounding fixations
if (use_run_rule) {
# Get indices of ambiguous pts
amb_ind <- (fix_data$ == 'amb')
# Go through each of these points
for (i amb_ind) {
# Go backwards to get category membership of previous keeper
j = i - 1
{
if (j <= 0)
prev_cat = -1
if (fix_data$[j] == 'keep')
prev_cat = fix_data$[j]
if (fix_data$[j] == 'oob')
prev_cat = -1
if (fix_data$[j] == 'den')
prev_cat = -1
if (fix_data$[j] == 'part')
prev_cat = -1
if (fix_data$[j] == 'nit')
prev_cat = -1
if (fix_data$[j] == 'amb') {
j = j - 1
}
}
# Go forwards to get category membership of next keeper
j = i + 1
{
if (j > (fix_data$))
next_cat = -1
if (fix_data$[j] == 'keep')
next_cat = fix_data$[j]
if (fix_data$[j] == 'oob')
next_cat = -1
if (fix_data$[j] == 'den')
next_cat = -1
if (fix_data$[j] == 'part')
# Shouldn't happen, but...
next_cat = -1
if (fix_data$[j] == 'nit')
# Shouldn't happen, but...
next_cat = -1
if (fix_data$[j] == 'amb') {
j = j + 1
}
}
# If both before and after are from the same category, reclassify
if (prev_cat == next_cat && prev_cat != -1) {
fix_data$[i] = 'keep'
fix_data$[i] = prev_cat
}
}
# Store the new category memberships
cats <- fix_data$
}
# Store recategorized y-values
if (keep_y_var)
for (i 1:(cats))
fix_data$y_new[i] <- ys[cats[i]] + y_diff[i, cats[i]]
fix_data$y_new <- ys[cats]
# Store category membership, untransformed parameters, fit measure, fixation data
line_ret <- ()
line_ret$cats <- cats
line_ret$params <- (k, o, s)
line_ret$fit_measure <- fit_measure
line_ret$fix_data <- fix_data
line_ret$start_pts <- start_pts
# Return it
(line_ret)
}
}
##############################
# do_trial_plots
##############################
do_trial_plots <-
(line_ret,
,
sub_file,
dur_five_num,
show_image,
save_trial_plots,
fa_dir) {
# Constants ----------------------------
xy_buffer = .1
pt_size_min = 1
pt_size_max = 7
# Handle data --------------------------
# Separate out the fixation data
fix_data_all <- line_ret$fix_data
# Point sizes based on duration
m <-
(pt_size_max - pt_size_min) / (dur_five_num[5] - dur_five_num[1])
fix_data_all$pt_size <-
m * (fix_data_all$dur - dur_five_num[1]) + pt_size_min
# Separate out some more data
fix_data_keep <- fix_data_all[fix_data_all$ == 'keep', ]
cats_keep <- line_ret$cats[fix_data_all$ == 'keep']
fix_data_oob <- fix_data_all[fix_data_all$ == 'oob', ]
fix_data_den <- fix_data_all[fix_data_all$ == 'den', ]
fix_data_amb <- fix_data_all[fix_data_all$ == 'amb', ]
# Plot parameters ----------------------
old.par <- (no.readonly = )
(oma = (0, 0, 3, 0))
((1, 2))
(ask = )
# x and y limits
x_min <-
(fix_data_all$x) - xy_buffer * ((fix_data_all$x) - (fix_data_all$x))
x_max <-
(fix_data_all$x) + xy_buffer * ((fix_data_all$x) - (fix_data_all$x))
y_min <-
(fix_data_all$y) - xy_buffer * ((fix_data_all$y) - (fix_data_all$y))
y_max <-
(fix_data_all$y) + xy_buffer * ((fix_data_all$y) - (fix_data_all$y))
# Line info ----------------------
slope <- line_ret$params[1]
vert_offset <- line_ret$params[2]
start_pts <- line_ret$start_pts
n_lines <- (start_pts)
# Handle background images -----------------
if (show_image) {
if (!('png')) ('png') # modified: bing ----------------------------------------
(!('tiff')) ('tiff')
# Determine image to show
# Is there a specific image for this subject and trial?
image_file_name_trial <-
((sub_file, 1, (sub_file) - 4), '_', , '.png', sep =
'') # modified: bing -----------------------
if ((image_file_name_trial)) {
# Load the image
t_image <- readPNG(image_file_name_trial)
} {
# Get the subject specific image
image_file_name_sub <-
((sub_file, 1, (sub_file) - 4), '.png', sep = '') # modified: bing -----------------
if ((image_file_name_sub)) {
# Load the image
t_image <- readPNG(image_file_name_sub)
} {
# If the image file is missing show the data without it
(('Missing image for ', sub_file, ' trial ', , '.', sep =
''))
show_image <-
}
}
# modified: bing ------------------------------------------------------------------------
# FOLLOWING: original codes
# # Flip image upside-down
# t_image@red <- t_image@red[t_image@size[1]:0,]
# t_image@green <- t_image@green[t_image@size[1]:0,]
# t_image@blue <- t_image@blue[t_image@size[1]:0,]
#
# t_image_width = t_image@size[2]
# t_image_height = t_image@size[1]
# FOLLOWING: modified
##t_image <- t_image[length(t_image[, 1, 1]):1, ,]
t_image <- t_image, , 1] + t_image, , 2] + t_image, , 3]
t_image <- t_image / (t_image)
t_image_width <- (t_image[1, ])
t_image_height <- (t_image, 1])
# modified: bing ------------------------------------------------------------------------
}
# Make sure the directory exists
if (save_trial_plots)
if (!((fa_dir, 'Trial_Plots', sep = "/")))
((fa_dir, 'Trial_Plots', sep = "/"))
# Plot original data with deletions ----------------------
if (save_trial_plots)
(
= (
fa_dir,
'/Trial_Plots/Orig_',
('.asc', '', ('/', '_', sub_file)),
'_',
,
'.png',
sep = ""
),
= 4267,
= 3200,
= "px",
res = 800,
pointsize = 6
)
if (show_image) {
# If we're drawing an image
# plot(t_image,
# main='Original Fixations with Deletions & Classifications',
# xlab='x', ylab='y',
# xlim=c(0, t_image_width), ylim=c(t_image_height, 0))
(
(0, t_image_width),
(0, t_image_height),
main = 'Original Fixations with Deletions & Classifications',
xlab = 'x',
ylab = 'y',
= (0, t_image_width),
= (t_image_height, 0)
)
(t_image, 0, 0, t_image_width, t_image_height)
(1)
(2)
} {
# Blank plot
# Reverse y-limits so 0 at top
(
1,
= 'n',
main = 'Original Fixations with Deletions & Classifications',
xlab = 'x',
ylab = 'y',
= (x_min, x_max),
= (y_max, y_min)
)
}
# Lines for fixation ordering
(
fix_data_all$x,
fix_data_all$y,
cex = fix_data_all$pt_size,
= 'yellow',
= 1,
= 'l',
lty = 'dashed'
)
# The kept fixations
for (i 1:n_lines) {
<- cats_keep == i
# Alternate category colors
if (i %% 2 == 1)
= 'black'
= 'green'
(
fix_data_keep$x[cat],
fix_data_keep$y[cat],
cex = fix_data_keep$pt_size[cat],
= ,
= 1
)
}
# ----------------------------------------------------------------------------modified
(
fix_data_keep$x,
fix_data_keep$y,
= 1:(fix_data_keep$x),
= 'blue',
pos = 1
)
# The deleted fixations
(
fix_data_oob$x,
fix_data_oob$y,
cex = fix_data_oob$pt_size,
= 'red',
= 1
)
(
fix_data_den$x,
fix_data_den$y,
cex = fix_data_den$pt_size,
= 'orange',
= 1
)
(
fix_data_amb$x,
fix_data_amb$y,
cex = fix_data_amb$pt_size,
= 'purple',
= 1
)
# Show fitted lines
for (i 1:n_lines)
(
(start_pts[i, 1], x_max),
(
start_pts[i, 2] + vert_offset,
start_pts[i, 2] + slope * (x_max - x_min) + vert_offset
),
= 'grey'
)
(
x = 'bottomleft',
= ('Kept', 'Kept', 'Out-of-bounds', 'Low density', 'Ambiguous'),
= (1, 1, 1, 1, 1),
= ('black', 'green', 'red', 'orange', 'purple'),
bty = 'n'
)
# Show line parameters
(
x = 'bottomright',
= (
('Slope =', (line_ret$params[1], digits = 3)),
('VOffset =', (line_ret$params[2], digits = 3)),
('SD =', (line_ret$params[3], digits = 3)),
('Fit =', (line_ret$fit_measure, digits = 3))
),
bty = 'n'
)
if (save_trial_plots)
()
# Plot reformatted data ----------------------
if (save_trial_plots)
(
= (
fa_dir,
'/Trial_Plots/Reform_',
('.asc', '', ('/', '_', sub_file)),
'_',
,
'.png',
sep = ""
),
= 4267,
= 3200,
= "px",
res = 800,
pointsize = 6
)
if (show_image) {
# If we're drawing an image
(
#t_image,
(0, t_image_width),
(0, t_image_height),
main = 'Reformatted Fixations',
xlab = 'x',
ylab = 'New y',
= (0, t_image_width),
= (t_image_height, 0)
)
(t_image, 0, 0, t_image_width, t_image_height)
(1)
(2)
} {
# Blank plot
# Reverse y-limits so 0 at top
(
1,
= 'n',
main = 'Reformatted Fixations',
xlab = 'x',
ylab = 'New y',
= (x_min, x_max),
= (y_max, y_min)
)
}
# The fixations
for (i 1:n_lines) {
<- cats_keep == i
# Alternate category colors
if (i %% 2 == 1)
= 'black'
= 'green'
(
fix_data_keep$x[cat],
fix_data_keep$y_new[cat],
cex = fix_data_keep$pt_size[cat],
= ,
= 1
)
}
# Show desired lines
for (i 1:n_lines)
((start_pts[i, 1], x_max),
(start_pts[i, 2], start_pts[i, 2]),
= 'grey')
# Duration scale information
(
x = 'bottomleft',
= (
(dur_five_num[1], 'ms'),
(dur_five_num[2], 'ms'),
(dur_five_num[3], 'ms'),
(dur_five_num[4], 'ms'),
(dur_five_num[5], 'ms')
),
= (1, 1),
pt.cex = (
m * (dur_five_num[1] - dur_five_num[1]) + pt_size_min,
m * (dur_five_num[2] - dur_five_num[1]) + pt_size_min,
m * (dur_five_num[3] - dur_five_num[1]) + pt_size_min,
m * (dur_five_num[4] - dur_five_num[1]) + pt_size_min,
m * (dur_five_num[5] - dur_five_num[1]) + pt_size_min
),
= ('black', 'black'),
bty = 'n'
)
(('File: ', sub_file, ', Trial: ', , sep = ''), = )
if (save_trial_plots)
()
}
##############################
# save_summary
##############################
save_summary <- (line_ret, sub_file, out_file, n_trials) {
for ( 1:n_trials)
{
slope <- line_ret[t]]$params[1]
voffset <- line_ret[t]]$params[2]
<- line_ret[t]]$params[3]
fit <- line_ret[t]]$fit_measure
n_total_fix <- (line_ret[t]]$fix_data)
count_table <- (line_ret[t]]$fix_data$)
n_keep <-
(line_ret[t]]$fix_data$[line_ret[t]]$fix_data$ == 'keep'])
n_oob <-
(line_ret[t]]$fix_data$[line_ret[t]]$fix_data$ == 'oob'])
n_amb <-
(line_ret[t]]$fix_data$[line_ret[t]]$fix_data$ == 'amb'])
n_den <-
(line_ret[t]]$fix_data$[line_ret[t]]$fix_data$ == 'den'])
n_nit <-
(line_ret[t]]$fix_data$[line_ret[t]]$fix_data$ == 'nit'])
n_part <-
(line_ret[t]]$fix_data$[line_ret[t]]$fix_data$ == 'part'])
(
(
sub_file,
,
slope,
voffset,
,
fit,
n_total_fix,
n_keep,
n_oob,
n_amb,
n_den,
n_nit,
n_part,
'\n',
sep = ' '
),
= out_file
)
}
}
##############################
# write_asc_file
##############################
write_asc_file <-
(line_ret,
orig_asc_file_name,
n_trials,
fa_dir,
start_flag,
asc_data) {
# Name and open the new asc file
# fa = (f)ix_(a)lign
# Check if directory exists, if not, make
if (!(fa_dir))
(fa_dir)
# Make the file name
new_asc_file_name <- (orig_asc_file_name, '/')
new_asc_file_name <-
new_asc_file_name[1]][length(new_asc_file_name[1]])]
new_asc_file_name <- ('.asc', '_fa.asc', new_asc_file_name)
new_asc_file_name <- (fa_dir, '/', new_asc_file_name, sep = '')
out_file <- (new_asc_file_name, 'w')
# Read in the file
f <- (orig_asc_file_name)
# Find all of the EFIX lines after start_flag, put into 1 vector
trial_id_start <- asc_data$trial_id_start
trial_start <- asc_data$trial_start
trial_end <- asc_data$trial_end
efix_lines <- (0)
for ( 1:n_trials) {
trial_data <- f[trial_id_start[t]:trial_end[t]]
trial_end_fix <- (('EFIX', trial_data))
efix_lines <-
(efix_lines, trial_end_fix + trial_id_start[t] - 1)
}
# Make a vector of all of the y-values in line_ret
line_ret_y_vals <- (0)
for ( 1:n_trials) {
# Get a single trial of data
line_ret_trial <- line_ret[t]]
# Mark the y-values for the deleted fixations
line_ret_trial$fix_data$y_new[line_ret_trial$fix_data$ == 'nit'] <-
-1000
line_ret_trial$fix_data$y_new[line_ret_trial$fix_data$ == 'part'] <-
-1001
line_ret_trial$fix_data$y_new[line_ret_trial$fix_data$ == 'oob'] <-
-1002
line_ret_trial$fix_data$y_new[line_ret_trial$fix_data$ == 'amb'] <-
-1003
line_ret_trial$fix_data$y_new[line_ret_trial$fix_data$ == 'den'] <-
-1004
# Add the y-values onto the end of the vector
line_ret_y_vals <-
(line_ret_y_vals, line_ret_trial$fix_data$y_new)
}
# Go through each fixation
k <- 1
for (i efix_lines) {
# Parse out the fixation
fix_data <- ('\\s+', ' ', f[i])
fix_data <- (fix_data, ' ')
# What is the next reformatted y-coordinate
next_y <- line_ret_y_vals[k]
# Change y-coordinate
fix_data[1]][7] <- next_y
# Overwrite the original line
f[i] <- (fix_data[1]], sep = '', collapse = ' ')
k <- k + 1
}
# Write the file
#writeLines(f, out_file)
(f, out_file, sep = "\r\n") # Thanks to Brian Dillon for this suggestion
# Close the file
(out_file)
}
