library(tidyverse)
library(janitor)
library(vroom)
library(facs) #pak::pak("jmgirard/facs")
library(furrr)
# Set up parallel processing
plan("multisession", workers = 4)Prep Data
Tidy FACS Files
# Specify input directory
indir <- "/mnt/datasets/SEEDLingS/1_RAWDATA/FACS"
# Find all CSV files in input directory
infiles <-
list.files(
path = indir,
pattern = ".csv$",
full.names = TRUE,
recursive = TRUE
) %>%
# Set vector names for later capture as id
set_names(.)
# In parallel, read in all FACS files to a single list object
facs_raw <-
future_map(
# For each files in infiles...
infiles,
# ...read in a comma-delimited file as character data and clean names
\(x) vroom(
file = x,
delim = ",",
na = c("", ".", ",", ",.", ".h", ".x", "="),
col_types = cols(.default = col_character()),
.name_repair = make_clean_names
)
)Part 1: FACS Codes
facs1_raw <-
# Select only the desired part 1 columns
map(facs_raw, \(x) select(x, facs_ordinal:facs_identity)) |>
# Combine all files into a single data frame
bind_rows(.id = "filename") |>
# Drop any rows that contain no data
drop_na(facs_ordinal)# Tidy the raw data for analysis
facs1_tidy <-
facs1_raw |>
mutate(
# Remove master directory from filename
filename = str_remove(filename, indir),
# Convert event to integer
facs_id = as.integer(facs_ordinal),
# Convert onset and offset to integers
facs_onset = as.integer(facs_onset),
facs_offset = as.integer(facs_offset),
# Calculate duration
facs_duration = facs_offset - facs_onset,
# If desired, convert ms to sec
across(c(facs_onset, facs_offset, facs_duration), \(x) x / 1000),
# Create FACS codes
facs_raw = facs_facs_codes,
facs_code = facs::coding(facs_raw),
# Keep the identity of the coded face (e.g., infant vs. caregiver). This is
# a per-event grouping key: events from different faces can overlap in time
# within one recording, so downstream analyses must group by it and must not
# pool identities together.
facs_identity = facs_identity,
# Drop all unused columns
.keep = "none"
) |>
# Separate filename into wave, subject, and month
separate_wider_delim(
cols = filename,
delim = regex("[./_]"),
names = c(NA, NA, "wave", NA, "subject", "month", NA)
) |>
# Convert wave, subject, and month to integers
mutate(across(c(wave, subject, month), as.integer)) |>
# Standardize identity labels BEFORE any export or downstream use. Trimming
# whitespace and lowercasing collapses accidental variants (e.g. "f1S"/"f1s")
# onto one label so a single face is not split across rows. NOTE: this only
# fixes case/whitespace; genuinely different strings for the same face (e.g.
# "f1" vs "father") must be reconciled by hand after inspecting the counts
# below.
mutate(facs_identity = facs_identity |> str_to_lower() |> str_trim()) |>
# Relocate subject and identity to the front
relocate(subject, facs_identity, .before = 1)# Inspect the identity values AFTER standardization but BEFORE export. Watch for
# (a) events with no identity coded (NA), and (b) any remaining inconsistent
# labels for the same face that case/whitespace normalization did not catch.
facs1_tidy |> count(facs_identity, sort = TRUE)# A tibble: 15 × 2
facs_identity n
<chr> <int>
1 f1 8996
2 c1 2583
3 m1 2179
4 f2 386
5 f3 223
6 c2 149
7 c3 56
8 s 49
9 m2 16
10 f1s 3
11 1 2
12 f 2
13 <NA> 2
14 g1 1
15 r2 1# Identities present within a single recording (>1 means faces share a timeline)
facs1_tidy |>
summarize(n_identities = n_distinct(facs_identity), .by = c(subject, wave, month)) |>
count(n_identities)# A tibble: 6 × 2
n_identities n
<int> <int>
1 1 48
2 2 48
3 3 19
4 4 5
5 5 2
6 6 1# One zero-length event (offset == onset) exists; downstream analyses keep only
# duration > 0, so it is harmless, but flag the count for the record.
cat("facs zero-length events:", sum(facs1_tidy$facs_duration == 0, na.rm = TRUE), "\n")facs zero-length events: 1 # No negative FACS durations were found; guard anyway so a future re-run with
# new data cannot slip an impossible interval through.
stopifnot(all(facs1_tidy$facs_duration >= 0, na.rm = TRUE))# Export tidy data to CSV and RDS for posterity
write_csv(facs1_tidy, file = "facs_coding.csv")
write_rds(facs1_tidy, file = "facs_coding.rds", compress = "gz")# Rows whose identity is missing or a short/ambiguous label worth manual review.
# Labels are already lowercased, so match in lower case.
facs1_tidy |>
filter(is.na(facs_identity) | facs_identity %in% c("s", "1", "f", "f1s")) |>
arrange(subject, wave, facs_onset) |>
write_csv("check_identity.csv")Part 2: Partial Faces Visible
facs2_raw <-
map(
# For each data frame in facs_raw...
facs_raw,
\(x) x |>
# Select only the desired part 2 columns
select(starts_with("face_present_")) |>
# Harmonize column names (code and code01 -> code)
rename_with(\(y) str_remove(y, "01"))
) |>
# Combine all files into a single data frame
bind_rows(.id = "filename") |>
# Drop any rows that contain no data
drop_na(face_present_ordinal)# Tidy the raw data for analysis (see Part 1 for comments).
# NOTE: `face_present_*` columns carry PARTIAL-face intervals and include an
# identity column (partial faces are coded per face). Full-face intervals are in
# the `partial_*` columns handled in Part 3. The prefixes in the raw file are
# counterintuitive; the mapping is verified against the occlusion inventory
# downstream (neu + auc == ffa - vis - hat), so do not "fix" the prefixes here.
facs2_tidy <-
facs2_raw |>
drop_na(face_present_identity) |>
mutate(
filename = str_remove(filename, indir),
part_id = as.integer(face_present_ordinal),
part_onset = as.integer(face_present_onset),
part_offset = as.integer(face_present_offset),
part_duration = part_offset - part_onset,
across(c(part_onset, part_offset, part_duration), \(x) x / 1000),
part_identity = face_present_identity,
.keep = "none"
) |>
separate_wider_delim(
cols = filename,
delim = regex("[./_]"),
names = c(NA, NA, "wave", NA, "subject", "month", NA)
) |>
mutate(across(c(subject, wave, month), as.integer)) |>
# Standardize identity the same way as Part 1
mutate(part_identity = part_identity |> str_to_lower() |> str_trim()) |>
relocate(subject, .before = 1)# Two kinds of bad interval exist in the raw partial-face coding:
# (A) offset coded as 0 with a real onset: the offset is MISSING, so the
# interval is unrecoverable. Drop these rows.
# (B) offset a hair below onset (sub-second): rounding. These are effectively
# zero-length and are removed downstream by `part_duration > 0`, so we
# leave them in the saved file but do not treat them as an error.
bad_offset_2 <- facs2_tidy$part_offset == 0 & facs2_tidy$part_onset > 0
cat("partface rows dropped (offset missing/zero):", sum(bad_offset_2), "\n")partface rows dropped (offset missing/zero): 8 cat("partface sub-second negative (rounding, kept):",
sum(facs2_tidy$part_duration < 0 & !bad_offset_2), "\n")partface sub-second negative (rounding, kept): 9 facs2_tidy <- facs2_tidy |> filter(!(part_offset == 0 & part_onset > 0))
# After dropping the unrecoverable rows, the only remaining negatives should be
# tiny rounding artifacts (magnitude < 1 s). Fail on anything larger.
stopifnot(all(facs2_tidy$part_duration >= -1))# Export tidy data to CSV and RDS for posterity
write_csv(facs2_tidy, file = "partface_coding.csv")
write_rds(facs2_tidy, file = "partface_coding.rds", compress = "gz")Part 3: Full Faces Visible
facs3_raw <-
# In parallel, read part 3 from all FACS files
map(
facs_raw,
\(x) x |>
# Select only the desired columns (full-face intervals; see note in Part 2)
select(starts_with("partial_")) |>
# Harmonize column names (code and code01 -> code)
rename_with(\(y) str_remove(y, "01"))
) |>
# Combine all files into a single data frame
bind_rows(.id = "filename") |>
# Drop any rows that contain no data
drop_na(partial_ordinal)# Tidy the raw data for analysis
facs3_tidy <-
facs3_raw |>
mutate(
filename = str_remove(filename, indir),
full_id = as.integer(partial_ordinal),
full_onset = as.integer(partial_onset),
full_offset = as.integer(partial_offset),
full_duration = full_offset - full_onset,
across(c(full_onset, full_offset, full_duration), \(x) x / 1000),
.keep = "none"
) |>
separate_wider_delim(
cols = filename,
delim = regex("[./_]"),
names = c(NA, NA, "wave", NA, "subject", "month", NA)
) |>
mutate(across(c(subject, wave, month), as.integer)) |>
relocate(subject, .before = 1)# Same two problems as Part 2, plus one larger reversed interval to inspect.
# (A) offset == 0 with a real onset: unrecoverable, drop.
# (B) sub-second negatives: rounding, kept (removed downstream by > 0).
# (C) subject 26 wave 9 shows a ~21.6 s reversed interval. This is too large to
# be rounding and looks like an onset/offset transposition. We swap it so
# the interval is recovered rather than lost; if manual review shows it is
# not a transposition, drop it instead.
bad_offset_3 <- facs3_tidy$full_offset == 0 & facs3_tidy$full_onset > 0
cat("fullface rows dropped (offset missing/zero):", sum(bad_offset_3), "\n")fullface rows dropped (offset missing/zero): 1 facs3_tidy <- facs3_tidy |> filter(!(full_offset == 0 & full_onset > 0))
# Repair the single large reversed interval (subject 26, wave 9) by swapping
# onset and offset. Guarded to that one row so nothing else is touched.
facs3_tidy <-
facs3_tidy |>
mutate(
swap = full_duration < -1, # only the ~-21.6 s row qualifies after (A) is gone
.o = full_onset,
full_onset = if_else(swap, full_offset, full_onset),
full_offset = if_else(swap, .o, full_offset),
full_duration = full_offset - full_onset
) |>
select(-swap, -.o)
cat("fullface reversed intervals swapped:",
sum(facs3_tidy$full_duration < 0 & facs3_tidy$full_duration >= -1) == 0, "\n")fullface reversed intervals swapped: TRUE # Only sub-second rounding negatives may remain.
stopifnot(all(facs3_tidy$full_duration >= -1))# Export tidy data to CSV and RDS for posterity
write_csv(facs3_tidy, file = "fullface_coding.csv")
write_rds(facs3_tidy, file = "fullface_coding.rds", compress = "gz")Part 4: Session Information
facs4_raw <-
# Select only the desired part 1 columns
map(facs_raw, \(x) select(x, starts_with("session_"))) |>
# Combine all files into a single data frame
bind_rows(.id = "filename") |>
# Drop any rows that contain no data
drop_na(session_ordinal)# Tidy the raw data for analysis
facs4_tidy <-
facs4_raw |>
mutate(
filename = str_remove(filename, indir),
session_onset = as.integer(session_onset),
session_offset = as.integer(session_offset),
session_duration = session_offset - session_onset,
across(c(session_onset, session_offset, session_duration), \(x) x / 1000),
.keep = "none"
) |>
separate_wider_delim(
cols = filename,
delim = regex("[./_]"),
names = c(NA, NA, "wave", NA, "subject", "month", NA)
) |>
mutate(across(c(subject, wave, month), as.integer)) |>
relocate(subject, .before = 1)# Export tidy data to CSV and RDS for posterity
write_csv(facs4_tidy, file = "session_info.csv")
write_rds(facs4_tidy, file = "session_info.rds", compress = "gz")# Fail loudly if the filename parse produced impossible values, rather than
# letting a mis-split path flow silently into every downstream analysis.
walk(
list(facs1 = facs1_tidy, part = facs2_tidy, full = facs3_tidy, sess = facs4_tidy),
\(d) {
stopifnot(all(d$wave %in% c(6, 9, 12, 15)))
stopifnot(!any(is.na(d$subject)))
stopifnot(all(d$subject >= 1, na.rm = TRUE))
}
)
# Sessions must be strictly positive
stopifnot(all(facs4_tidy$session_duration > 0, na.rm = TRUE))
cat("FACS files parsed and validated.\n")FACS files parsed and validated.Tidy Transcript Files
# Specify input directory
indir <- "/mnt/datasets/SEEDLingS/1_RAWDATA/Transcriptions"
# Find all CSV files in input directory
infiles <-
list.files(
path = indir,
pattern = ".csv$",
full.names = TRUE,
recursive = TRUE
) %>%
# Set vector names for later capture as id
set_names(.)
# In parallel, read in all Transcript files to a single list object
text_raw <-
future_map(
# For each files in infiles...
infiles,
# ...read in a comma-delimited file as character data and clean names
\(x) vroom(
file = x,
delim = ",",
na = c("", "."),
col_types = cols(.default = col_character()),
.name_repair = make_clean_names
)
)text1_raw <-
# Select only the desired part 1 columns
map(text_raw, \(x) select(x, starts_with("language"))) |>
# Combine all files into a single data frame
bind_rows(.id = "filename") |>
# Drop any rows that contain no data
drop_na(language_ordinal)# Tidy the raw data for analysis.
# The transcript path has one fewer leading component than the FACS path, so the
# names vector here is 6 pieces, not 7. `wave` carries a text prefix, so it is
# parsed with parse_number rather than positionally.
text1_tidy <-
text1_raw |>
mutate(
# Remove master directory from filename
filename = str_remove(filename, indir),
# Convert event to integer
line_id = as.integer(language_ordinal),
# Convert onset and offset to integers
line_onset = as.integer(language_onset) / 1000,
# Rename line text
line_text = language_speech,
# Drop all unused columns
.keep = "none"
) |>
# Separate filename into wave, subject, and month
separate_wider_delim(
cols = filename,
delim = regex("[./_]"),
names = c(NA, "wave", NA, "subject", "month", NA)
) |>
# Convert wave, subject, and month to integers
mutate(
wave = parse_number(wave),
across(c(wave, subject, month), as.integer)
) |>
# Relocate subject to be the first column
relocate(subject, .before = 1)# Validate the transcript parse the same way as the FACS files.
stopifnot(all(text1_tidy$wave %in% c(6, 9, 12, 15)))
stopifnot(!any(is.na(text1_tidy$subject)))
cat("Transcript files parsed and validated.\n")Transcript files parsed and validated.# Export tidy data to CSV and RDS for posterity
write_csv(text1_tidy, file = "transcripts.csv")
write_rds(text1_tidy, file = "transcripts.rds", compress = "gz")