Peroxisomal import is circadian in glia and regulates sleep and lipid metabolism.

Code ↔ Paper

1 match between paragraphs of the paper and lines of its authors' code, computed by the harvester (lexical-v1). Click a colored paragraph or line to see its counterpart.

The 1 match

[1] § Results › Loss of Pex5 selectively in cortex glia disrupts sleep ↔ Sleep/DAM_2026_Das_metrics.R, lines 1088–1148 · score 0.57 · Sleep bout duration, beam crossings, Activity bouts, S1, min, day

Paper

Loaded from Europe PMC by your browser, not stored by OSCR: doi.org · Europe PMC

The paper is loaded when this pane is shown.

The paper is loaded by your browser, with JavaScript: read it at doi.org or on Europe PMC.

The authors' code

R · 3,769 lines · 129 KB · no license · 1 match

####read me####
#Code for drosophila activity monitor analysis, modified for R from python scripts from Vaughen et al 2022
#Reads .txt activity monitor files saved in subfolders for different GAL4 drivers depleting Pex5. Experiments were done in LD except for DD run of cortex glia (GMR77A03)
#Code outputs similar graphs and metrics for these 4 conditions (GMR57C10, GMR77A03 (LD), GMR77A03 (DD), and GMR57C10)
#outputs graphs and metrics are saved in same subfolders (ie GMR57C10)
####install packages if not installed and load libs####
#install.packages("openxlsx")
library(readr)
library(dplyr)
library(tidyr)
library(lubridate)
library(stringr)
library(cowplot)
library(grid)
library(openxlsx)
#install.packages("ggplot2")
#install.packages("patchwork")
#install.packages("gtable") # brings you to ≥ 0.3.6
#install.packages(c("ggplot2","patchwork"))# good to align deps
#packageVersion("gtable"); packageVersion("patchwork")
####Functions####
parse_dam_file <- function(path, date_start, date_end,
tz = "America/Los_Angeles",
expect_tubes = 32,
fill_missing = TRUE) {
# Read everything as character, then coerce
raw <- suppressMessages(
readr::read_tsv(
file = path,
col_names = FALSE,
col_types = readr::cols(.default = readr::col_character()),
progress = FALSE,
na = c("", "NA")
)
)
req_cols <- 10 + expect_tubes
if (ncol(raw) < req_cols) {
stop(sprintf("%s: found %d columns; need >= %d (10 meta + %d tubes)",
basename(path), ncol(raw), req_cols, expect_tubes))
}
nm <- c("row","date","time","c4","c5","c6","c7","group","c9","light",
paste0("tube", seq_len(expect_tubes)))
names(raw)[seq_along(nm)] <- nm
raw <- raw[, nm]
# Parse timestamp robustly and snap to exact minute boundary
ts0 <- suppressWarnings(lubridate::dmy(raw$date, tz = tz) + lubridate::hms(raw$time))
ts0 <- lubridate::force_tz(ts0, tz) # enforce tz
ts0 <- lubridate::floor_date(ts0, unit = "minute") # snap to minute
raw$ts <- ts0
raw$light <- suppressWarnings(as.integer(raw$light))
raw$file <- basename(path)
# Coerce tube columns to integer
tube_cols <- paste0("tube", seq_len(expect_tubes))
raw[tube_cols] <- lapply(raw[tube_cols], function(x) {
x <- trimws(x); suppressWarnings(as.integer(x))
})
# Trim to date window
start_ts <- lubridate::ymd_hms(paste0(date_start, " 00:00:00"), tz = tz)
end_ts <- lubridate::ymd_hms(paste0(date_end, " 23:59:59"), tz = tz)
raw <- raw %>%
dplyr::filter(!is.na(ts), ts >= start_ts, ts <= end_ts) %>%
dplyr::arrange(ts)
# Build an integer minute index to avoid POSIXct join issues
raw <- raw %>%
dplyr::mutate(min_index = as.integer(difftime(ts, min(ts), units = "mins")))
if (fill_missing && nrow(raw) > 1) {
full_idx <- tibble::tibble(min_index = 0:as.integer(difftime(max(raw$ts), min(raw$ts), units = "mins")))
raw <- dplyr::left_join(full_idx, raw, by = "min_index")
raw$is_padded <- is.na(raw$file) # rows created by padding
# carry metadata/light forward
raw <- raw %>%
tidyr::fill(file, date, time, ts, .direction = "down") %>%
tidyr::fill(light, .direction = "down")
} else {
raw$is_padded <- FALSE
}
# Long form
long <- raw %>%
tidyr::pivot_longer(dplyr::starts_with("tube"), names_to = "tube", values_to = "count") %>%
dplyr::mutate(
tube = as.integer(stringr::str_remove(tube, "tube")),
count = suppressWarnings(as.integer(count)),
count_na0 = dplyr::coalesce(count, 0L)
)
dplyr::select(long, ts, light, tube, count, count_na0, file, date, time, is_padded)
}
read_dam_specs <- function(specs,
date_start = NULL, date_end = NULL,
tz = "America/Los_Angeles",
expect_tubes = 32,
fill_missing = TRUE) {
stopifnot(is.list(specs), length(specs) >= 1)
parts <- lapply(specs, function(s) {
stopifnot(is.list(s), !is.null(s$path), !is.null(s$genotype))
tubes <- if (is.null(s$tubes)) 1:expect_tubes else as.integer(s$tubes)
# per-spec overrides (fall back to function args if missing)
ds <- if (!is.null(s$date_start)) s$date_start else date_start
de <- if (!is.null(s$date_end)) s$date_end else date_end
if (is.null(ds) || is.null(de)) {
stop("Provide date_start/date_end either in each spec or as function defaults.")
}
run_id <- if (!is.null(s$run_id)) as.character(s$run_id) else basename(s$path)
df1 <- parse_dam_file(s$path, ds, de, tz, expect_tubes, fill_missing)
df1 %>%
dplyr::filter(tube %in% tubes) %>%
dplyr::mutate(
genotype = as.character(s$genotype),
run_id = run_id
)
})
dplyr::bind_rows(parts)
}
remove_dead <- function(df,
inactivity_hours = 12,
quiet = FALSE,
use_is_padded = TRUE,
group_vars = c("genotype","tube")) {
thr <- as.integer(inactivity_hours * 60) # minutes
max_zero_run <- function(v) {
is_zero <- (!is.na(v)) & (v == 0L)
if (!any(is_zero)) return(0L)
r <- rle(is_zero)
max(ifelse(r$values, r$lengths, 0L))
}
# Ensure is_padded exists if we want to use it
if (use_is_padded && !("is_padded" %in% names(df))) df$is_padded <- FALSE
# For death detection, treat padded rows as NA
df_dead <- df %>%
dplyr::mutate(
count_dead = dplyr::if_else(
use_is_padded & dplyr::coalesce(is_padded, FALSE),
NA_integer_,
suppressWarnings(as.integer(count))
)
)
tube_stats <- df_dead %>%
dplyr::arrange(ts) %>%
dplyr::group_by(dplyr::across(dplyr::all_of(group_vars))) %>%
dplyr::summarise(
n_minutes = sum(!is.na(count_dead)),
max_zero_run_min = max_zero_run(count_dead),
.groups = "drop"
) %>%
dplyr::mutate(is_dead = max_zero_run_min >= thr)
purged <- tube_stats %>% dplyr::filter(is_dead)
kept <- tube_stats %>% dplyr::filter(!is_dead)
df2 <- df %>% dplyr::semi_join(kept, by = group_vars)
attr(df2, "purged") <- purged
attr(df2, "tube_stats") <- tube_stats
# ---- robust summary (no `.data$missingcol` lookups) ----
summary_tbl <- tube_stats %>%
dplyr::count(genotype, is_dead, name = "n") %>%
tidyr::pivot_wider(
names_from = is_dead,
values_from = n,
names_prefix = "removed_",
values_fill = 0
)
# Add missing columns if pivot_wider didn't create them
if (!("removed_TRUE" %in% names(summary_tbl))) summary_tbl$removed_TRUE <- 0L
if (!("removed_FALSE" %in% names(summary_tbl))) summary_tbl$removed_FALSE <- 0L
summary_tbl <- summary_tbl %>%
dplyr::transmute(
genotype,
removed_TRUE,
kept = removed_FALSE,
total = removed_TRUE + removed_FALSE
)
if (!quiet) {
for (i in seq_len(nrow(summary_tbl))) {
g <- summary_tbl$genotype[i]
r <- summary_tbl$removed_TRUE[i]
k <- summary_tbl$kept[i]
message(sprintf("Genotype %-12s: removed %2d, kept %2d (total %2d)", g, r, k, r + k))
}
}
list(
data = df2,
purged = purged,
tube_stats = tube_stats,
summary = summary_tbl
)
}
.phase_label <- function(light) dplyr::if_else(light == 1L, "Light", "Dark", missing = NA_character_)
plot_daynight_activity <- function(df, outdir = "DAM_Graphs", color_map = NULL,
width_in = 6, height_in = 4, dpi = 300) {
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
sum_tube <- df |>
dplyr::mutate(phase = .phase_label(light)) |>
dplyr::filter(!is.na(phase)) |>
dplyr::group_by(genotype, tube, phase) |>
dplyr::summarise(total = sum(count_na0, na.rm = TRUE), .groups = "drop")
sum_geno <- sum_tube |>
dplyr::group_by(genotype, phase) |>
dplyr::summarise(n = dplyr::n(), mean = mean(total), sem = stats::sd(total)/sqrt(n), .groups = "drop")
if (!is.null(color_map)) sum_geno$col <- unname(color_map[sum_geno$genotype])
p <- ggplot2::ggplot(sum_geno, ggplot2::aes(x = phase, y = mean, fill = genotype)) +
ggplot2::geom_col(position = ggplot2::position_dodge(width = 0.6), width = 0.6, color = "black", alpha = 0.9) +
ggplot2::geom_errorbar(ggplot2::aes(ymin = mean - sem, ymax = mean + sem),
position = ggplot2::position_dodge(width = 0.6), width = 0.2) +
ggplot2::labs(x = NULL, y = "Total activity (counts)", title = "DAM: Day vs Night Activity") +
ggplot2::theme_classic(base_size = 12)
if (!is.null(color_map)) {
p_main <- p_main +
ggplot2::scale_color_manual(values = color_map, labels = genotype_labels) +
ggplot2::scale_fill_manual(values = color_map, labels = genotype_labels) +
ggplot2::guides(
color = ggplot2::guide_legend(label = ggplot2::label_parsed),
fill = ggplot2::guide_legend(label = ggplot2::label_parsed)
)
}
out <- file.path(outdir, sprintf("DAM_activity_day_night_%s.png", format(Sys.time(), "%Y%m%d_%H%M%S")))
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, summary = sum_geno, file = out))
}
flag_sleep_minutes <- function(count, sleep_block_min = 5L) {
# count: integer vector with possible NA; NA breaks runs
is_zero <- (!is.na(count)) & (count == 0L)
r <- rle(is_zero)
idx <- rep.int(seq_along(r$lengths), r$lengths)
as.integer(is_zero & (r$lengths[idx] >= as.integer(sleep_block_min)))
}
plot_daynight_sleep <- function(df, sleep_block_min = 5L, outdir = "DAM_Graphs",
color_map = NULL, width_in = 6, height_in = 4, dpi = 300) {
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
sleep_df <- df |>
dplyr::arrange(ts) |>
dplyr::group_by(genotype, tube) |>
dplyr::mutate(sleep_flag = flag_sleep_minutes(count, sleep_block_min)) |>
dplyr::ungroup() |>
dplyr::mutate(phase = .phase_label(light)) |>
dplyr::filter(!is.na(phase))
sum_tube <- sleep_df |>
dplyr::group_by(genotype, tube, phase) |>
dplyr::summarise(total_sleep_min = sum(sleep_flag, na.rm = TRUE), .groups = "drop")
sum_geno <- sum_tube |>
dplyr::group_by(genotype, phase) |>
dplyr::summarise(n = dplyr::n(), mean = mean(total_sleep_min), sem = stats::sd(total_sleep_min)/sqrt(n), .groups = "drop")
p <- ggplot2::ggplot(sum_geno, ggplot2::aes(x = phase, y = mean, fill = genotype)) +
ggplot2::geom_col(position = ggplot2::position_dodge(width = 0.6), width = 0.6, color = "black", alpha = 0.9) +
ggplot2::geom_errorbar(ggplot2::aes(ymin = mean - sem, ymax = mean + sem),
position = ggplot2::position_dodge(width = 0.6), width = 0.2) +
ggplot2::labs(x = NULL, y = sprintf("Total sleep (min, ≥%d-min bouts)", as.integer(sleep_block_min)),
title = "DAM: Day vs Night Sleep") +
ggplot2::theme_classic(base_size = 12)
if (!is.null(color_map)) p_main <- p_main +
ggplot2::scale_color_manual(values = color_map, labels = genotype_labels) +
ggplot2::scale_fill_manual(values = color_map, labels = genotype_labels) +
ggplot2::guides(
color = ggplot2::guide_legend(label = ggplot2::label_parsed),
fill = ggplot2::guide_legend(label = ggplot2::label_parsed)
)
out <- file.path(outdir, sprintf("DAM_sleep_day_night_%s.png", format(Sys.time(), "%Y%m%d_%H%M%S")))
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, summary = sum_geno, file = out))
}
infer_light_cycle <- function(df, zt0_hour = 6L) {
tz_ts <- lubridate::tz(df$ts)
if (is.null(tz_ts) || tz_ts == "") tz_ts <- "UTC"
min_ts <- suppressWarnings(min(df$ts, na.rm = TRUE))
max_ts <- suppressWarnings(max(df$ts, na.rm = TRUE))
if (!is.finite(min_ts)) stop("infer_light_cycle(): df$ts has no finite values.")
# IMPORTANT: day boundaries in the SAME tz as ts
min_day <- as.Date(lubridate::with_tz(min_ts, tz_ts))
max_day <- as.Date(lubridate::with_tz(max_ts, tz_ts))
days <- seq.Date(min_day, max_day, by = "day")
# IMPORTANT: create scheduled ON/OFF in SAME tz as ts
sched <- tibble::tibble(
day = days,
ON_sched = lubridate::as_datetime(days, tz = tz_ts) + lubridate::hours(zt0_hour),
OFF_sched = lubridate::as_datetime(days, tz = tz_ts) + lubridate::hours(zt0_hour + 12L)
)
x0 <- df |>
dplyr::filter(!is.na(light)) |>
dplyr::distinct(ts, light) |>
dplyr::arrange(ts)
# DD/LL/UNKNOWN: just use scheduled subjective times
if (nrow(x0) == 0 || length(unique(x0$light)) == 1) {
mode <- if (nrow(x0) == 0) "UNKNOWN" else if (unique(x0$light) == 0L) "DD" else "LL"
per_day <- sched |> dplyr::transmute(day, ON = ON_sched, OFF = OFF_sched)
return(list(
mode = mode,
per_day = per_day,
summary = tibble::tibble(
zt0_ref = stats::median(per_day$ON, na.rm = TRUE),
zt12_ref = stats::median(per_day$OFF, na.rm = TRUE)
)
))
}
# LD inference + fill missing with schedule (also tz-safe because sched is tz-safe)
x <- x0 |>
dplyr::mutate(prev = dplyr::lag(light),
changed = !is.na(prev) & light != prev) |>
dplyr::filter(changed) |>
dplyr::mutate(kind = dplyr::if_else(light == 1L, "ON", "OFF"),
day = as.Date(lubridate::with_tz(ts, tz_ts)))
per_day_inf <- x |>
dplyr::group_by(day, kind) |>
dplyr::summarise(time = min(ts), .groups = "drop") |>
tidyr::pivot_wider(names_from = kind, values_from = time)
if (!("ON" %in% names(per_day_inf))) per_day_inf$ON <- as.POSIXct(NA, tz = tz_ts)
if (!("OFF" %in% names(per_day_inf))) per_day_inf$OFF <- as.POSIXct(NA, tz = tz_ts)
per_day <- sched |>
dplyr::left_join(per_day_inf, by = "day") |>
dplyr::mutate(
ON = dplyr::coalesce(ON, ON_sched),
OFF = dplyr::coalesce(OFF, OFF_sched)
) |>
dplyr::select(day, ON, OFF)
list(
mode = "LD",
per_day = per_day,
summary = tibble::tibble(
zt0_ref = stats::median(per_day$ON, na.rm = TRUE),
zt12_ref = stats::median(per_day$OFF, na.rm = TRUE)
)
)
}
plot_average_day <- function(
df,
metric = c("activity","sleep"),
bin_minutes = 5L,
color_map = NULL,
genotype_labels = NULL, # <-- NEW: named plotmath strings
# appearance
mean_linewidth = 1.2,
sem_alpha = 0.3,
# titles/labels
title = NULL,
x_label = "ZT (h)",
y_label = NULL,
title_size = 20,
axis_title_size = 20,
axis_text_size = 14,
show_legend = TRUE,
# phase shading (background)
show_bg_phase_shading = TRUE,
bg_light_color = "#FFF7AE", bg_light_alpha = 0.18,
bg_dark_color = "#1E2430", bg_dark_alpha = 0.12,
# phase bar
show_phase_bar = TRUE,
phase_bar_position = c("inside","below"),
bar_light_color = "#FFD84D",
bar_dark_color = "#22313F",
bar_height_frac = 1/50, # used only for "inside"
# file
outdir = "DAM_Graphs",
filename = NULL,
width_in = 7, height_in = 4, dpi = 300
) {
phase_bar_position <- match.arg(phase_bar_position)
metric <- match.arg(metric)
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
# ----- data prep -----
lc <- infer_light_cycle(df, zt0_hour = 6L)
tz_ts <- lubridate::tz(df$ts)
if (is.null(tz_ts) || tz_ts == "") tz_ts <- "UTC"
per_day <- lc$per_day
mode <- lc$mode
# If user didn't override, use CT for constant conditions
if (is.null(x_label)) x_label <- "ZT (h)"
if (mode %in% c("DD","LL") && identical(x_label, "ZT (h)")) {
x_label <- "CT (h)"
}
df2 <- df |>
dplyr::mutate(day = as.Date(lubridate::with_tz(ts, tz_ts))) |>
dplyr::left_join(per_day |> dplyr::select(day, ON), by = "day") |>
dplyr::mutate(
zt_min = as.integer((as.numeric(difftime(ts, ON, units = "mins")) %% (24*60)))
)
if (metric == "sleep") {
df2 <- df2 |>
dplyr::arrange(ts) |>
dplyr::group_by(genotype, tube) |>
dplyr::mutate(sleep_flag = flag_sleep_minutes(count, sleep_block_min = 5L)) |>
dplyr::ungroup()
}
df2 <- df2 |>
dplyr::mutate(bin = (zt_min %/% bin_minutes) * bin_minutes)
agg_tube <- df2 |>
dplyr::group_by(genotype, tube, bin) |>
dplyr::summarise(
value = if (metric == "activity") mean(count_na0, na.rm = TRUE) else mean(sleep_flag, na.rm = TRUE),
.groups = "drop"
)
agg_geno <- agg_tube |>
dplyr::group_by(genotype, bin) |>
dplyr::summarise(
n = dplyr::n(),
mean = mean(value),
sem = stats::sd(value)/sqrt(n),
.groups = "drop"
) |>
dplyr::mutate(zt_h = bin/60)
if (is.null(y_label)) y_label <- if (metric == "activity") "Counts / min" else "Sleep prob. / min"
default_title <- sprintf("DAM average day: %s", metric)
# y-range (for "inside" bar)
y_min <- min(agg_geno$mean - agg_geno$sem, na.rm = TRUE)
y_max <- max(agg_geno$mean + agg_geno$sem, na.rm = TRUE)
yr <- y_max - y_min
bar_y0 <- y_min
bar_y1 <- y_min + yr * bar_height_frac
# ----- main plot -----
p_main <- ggplot2::ggplot(
agg_geno,
ggplot2::aes(x = zt_h, y = mean, color = genotype, fill = genotype)
)
if (show_bg_phase_shading) {
p_main <- p_main +
ggplot2::annotate("rect", xmin = 0, xmax = 12, ymin = -Inf, ymax = Inf,
fill = bg_light_color, alpha = bg_light_alpha, linewidth = 0) +
ggplot2::annotate("rect", xmin = 12, xmax = 24, ymin = -Inf, ymax = Inf,
fill = bg_dark_color, alpha = bg_dark_alpha, linewidth = 0)
}
p_main <- p_main +
ggplot2::geom_ribbon(ggplot2::aes(ymin = mean - sem, ymax = mean + sem),
alpha = sem_alpha, linewidth = 0) +
ggplot2::geom_line(linewidth = mean_linewidth) +
ggplot2::scale_x_continuous(breaks = seq(0,24,6), limits = c(0,24), expand = c(0,0)) +
ggplot2::labs(
x = if (show_phase_bar && phase_bar_position == "below") NULL else x_label,
y = y_label,
title = if (is.null(title)) default_title else title
) +
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
plot.title = ggplot2::element_text(hjust = 0.5, size = title_size),
axis.title.x = ggplot2::element_text(size = axis_title_size),
axis.title.y = ggplot2::element_text(size = axis_title_size),
axis.text = ggplot2::element_text(size = axis_text_size)
)
# ----- legend label parsing FIX -----
# We parse *in the scale*, not via guide_legend(label=label_parsed) (that often bites).
# genotype_labels should be a named character vector of plotmath strings.
if (!is.null(color_map)) {
# If user didn't provide labels, default to plain genotype names.
if (is.null(genotype_labels)) {
genotype_labels <- setNames(names(color_map), names(color_map))
use_parsed <- FALSE
} else {
# ensure same ordering / breaks across plots
use_parsed <- TRUE
# keep only labels that exist in the color_map ordering
genotype_labels <- genotype_labels[names(color_map)]
}
p_main <- p_main +
ggplot2::theme(
legend.text = ggplot2::element_text(size = 14),
legend.title = ggplot2::element_text(size = 0)
)
if (use_parsed) {
p_main <- p_main +
ggplot2::scale_color_manual(
values = color_map,
breaks = names(color_map),
labels = parse(text = genotype_labels)
) +
ggplot2::scale_fill_manual(
values = color_map,
breaks = names(color_map),
labels = parse(text = genotype_labels)
) +
ggplot2::guides(
# keep ONLY line legend
color = ggplot2::guide_legend(
label = ggplot2::label_parsed,
override.aes = list(fill = NA)
),
# remove ribbon legend entirely
fill = "none"
)
} else {
p_main <- p_main +
ggplot2::scale_color_manual(
values = color_map,
breaks = names(color_map),
labels = genotype_labels
) +
ggplot2::scale_fill_manual(
values = color_map,
breaks = names(color_map),
labels = genotype_labels
) +
ggplot2::guides(
color = ggplot2::guide_legend(override.aes = list(fill = NA)),
fill = "none"
)
}
}
# ----- phase bar handling -----
if (show_phase_bar && phase_bar_position == "inside") {
if (is.finite(yr) && yr > 0) {
p_main <- p_main +
ggplot2::annotate("rect", xmin = 0, xmax = 12, ymin = bar_y0, ymax = bar_y1,
fill = bar_light_color, alpha = 1, linewidth = 0) +
ggplot2::annotate("rect", xmin = 12, xmax = 24, ymin = bar_y0, ymax = bar_y1,
fill = bar_dark_color, alpha = 1, linewidth = 0)
}
p_final <- p_main
} else if (show_phase_bar && phase_bar_position == "below") {
p_bar <- ggplot2::ggplot() +
ggplot2::annotate("rect", xmin = 0, xmax = 12, ymin = 0, ymax = 1,
fill = bar_light_color, alpha = 1, linewidth = 0) +
ggplot2::annotate("rect", xmin = 12, xmax = 24, ymin = 0, ymax = 1,
fill = bar_dark_color, alpha = 1, linewidth = 0) +
ggplot2::scale_x_continuous(limits = c(0,24), expand = c(0,0)) +
ggplot2::coord_cartesian(ylim = c(0,1), clip = "off") +
ggplot2::labs(x = x_label, y = NULL) +
ggplot2::theme_void(base_size = 12) +
ggplot2::theme(
plot.margin = ggplot2::margin(t = -6, r = 5, b = 5, l = 5),
axis.title.x = ggplot2::element_text(size = axis_title_size, hjust = 0.5)
)
if (requireNamespace("patchwork", quietly = TRUE)) {
bar_rel <- bar_height_frac / max(1e-6, (1 - bar_height_frac))
p_final <- p_main / p_bar + patchwork::plot_layout(heights = c(1, bar_rel))
} else if (requireNamespace("cowplot", quietly = TRUE)) {
bar_rel <- bar_height_frac / max(1e-6, (1 - bar_height_frac))
p_final <- cowplot::plot_grid(
p_main + ggplot2::theme(axis.title.x = ggplot2::element_blank()),
p_bar, ncol = 1, rel_heights = c(1, bar_rel)
)
} else {
message("phase_bar_position='below' requested, but neither patchwork nor cowplot is installed; drawing without stacking.")
p_final <- p_main
}
} else {
p_final <- p_main
}
# ----- save -----
if (is.null(filename)) {
filename <- sprintf("DAM_avgday_%s_bin%dm.png", metric, bin_minutes)
}
out <- file.path(outdir, filename)
ggplot2::ggsave(out, p_final, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p_final, summary = agg_geno, file = out))
}
build_daynight_metric_avg <- function(df,
metric = c("activity","sleep"),
zt0_hour = 6L,
sleep_block_min = 5L) {
metric <- match.arg(metric)
lc <- infer_light_cycle(df, zt0_hour = zt0_hour)
per_day <- lc$per_day
mode <- lc$mode
tz_ts <- lubridate::tz(df$ts)
if (is.null(tz_ts) || tz_ts == "") tz_ts <- "UTC"
df2 <- df |>
dplyr::mutate(day = as.Date(lubridate::with_tz(ts, tz_ts))) |>
dplyr::left_join(per_day |> dplyr::select(day, ON), by = "day") |>
dplyr::mutate(
zt_min = as.integer((as.numeric(difftime(ts, ON, units = "mins")) %% (24*60))),
phase = dplyr::if_else(zt_min < 12*60, "Light", "Dark")
)
# ---- choose the per-minute value to average (DO NOT use if_else here) ----
if (metric == "activity") {
df2 <- df2 |>
dplyr::mutate(value_min = dplyr::coalesce(count_na0, dplyr::coalesce(count, 0)))
} else {
df2 <- df2 |>
dplyr::arrange(ts) |>
dplyr::group_by(genotype, tube) |>
dplyr::mutate(sleep_flag = flag_sleep_minutes(count, sleep_block_min = sleep_block_min)) |>
dplyr::ungroup() |>
dplyr::mutate(value_min = sleep_flag)
}
dn <- df2 |>
dplyr::group_by(genotype, tube, phase) |>
dplyr::summarise(
value = if (metric == "activity") mean(value_min, na.rm = TRUE) * (12*60) else mean(value_min, na.rm = TRUE),
.groups = "drop"
)
attr(dn, "mode") <- mode
attr(dn, "metric") <- metric
dn
}
plot_daynight_metric_box <- function(
df,
metric = c("activity","sleep"),
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = "DAM_Graphs",
color_map = NULL,
genotype_labels = NULL,
legend_text_size = 14,
legend_title_size = 0,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = TRUE,
show_dots = TRUE,
dot_size = 0.8,
show_kw_stars = FALSE,
show_brackets = TRUE,
drop_ns = TRUE,
title = NULL,
x_label = NULL,
y_label = NULL,
phase_labels = c(Light = "Day", Dark = "Night"),
width_in = 4, height_in = 4, dpi = 300,
filename = NULL
) {
metric <- match.arg(metric)
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
dn <- build_daynight_metric_avg(
df,
metric = metric,
zt0_hour = zt0_hour,
sleep_block_min = sleep_block_min
)
mode <- attr(dn, "mode")
if (is.null(x_label)) x_label <- if (mode %in% c("DD","LL")) "CT phase" else NULL
default_title <- if (metric == "activity") "Activity" else "Sleep"
default_y <- if (metric == "activity") "Beam crossings per 12h" else "Sleep probability / min"
# stable ordering
dn$phase <- factor(dn$phase, levels = names(phase_labels))
if (!is.null(color_map)) dn$genotype <- factor(dn$genotype, levels = names(color_map))
ctrl_vs_mut <- pairwise_vs_mutant_by_phase(
dn, value_col = "value",
mutant = mutant, controls = controls,
p_adjust = "BH"
) |>
dplyr::mutate(
p_use = dplyr::coalesce(p_adj, p),
label = .p_to_stars(p_use)
)
if (drop_ns) {
ctrl_vs_mut <- ctrl_vs_mut |> dplyr::filter(!is.na(label), label != "ns")
}
kw_only <- NULL
if (show_kw_stars) {
kw_only <- nonparam_stats_by_phase(dn, value_col = "value", p_adjust = "BH") |>
dplyr::filter(test == "Kruskal–Wallis") |>
dplyr::mutate(label = .p_to_stars(p))
if (drop_ns) kw_only <- kw_only |> dplyr::filter(label != "ns")
}
p <- ggplot2::ggplot(dn, ggplot2::aes(x = phase, y = value, fill = genotype)) +
ggplot2::geom_boxplot(
position = ggplot2::position_dodge(width = 0.6),
width = 0.6, alpha = 0.9, outlier.shape = NA
) +
ggplot2::labs(
x = x_label,
y = if (is.null(y_label)) default_y else y_label,
title = if (is.null(title)) default_title else title
) +
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
legend.text = ggplot2::element_text(size = legend_text_size),
legend.title = ggplot2::element_text(size = legend_title_size),
plot.title = ggplot2::element_text(hjust = 0.5, size = 26),
axis.title.y = ggplot2::element_text(size = 20),
axis.text = ggplot2::element_text(size = 14),
plot.margin = ggplot2::margin(t = 12, r = 10, b = 6, l = 6)
) +
ggplot2::scale_x_discrete(labels = phase_labels) +
ggplot2::scale_y_continuous(limits = c(0, NA),
expand = ggplot2::expansion(mult = c(0, 0.18))) +
ggplot2::coord_cartesian(clip = "off")
if (show_dots) {
p <- p + ggplot2::geom_point(
position = ggplot2::position_jitterdodge(jitter.width = 0.04, dodge.width = 0.6),
size = dot_size, alpha = 0.6, shape = 16, color = "black"
)
}
if (!is.null(color_map)) {
if (!is.null(genotype_labels)) {
genotype_labels <- genotype_labels[names(color_map)]
p <- p +
ggplot2::scale_fill_manual(
values = color_map,
breaks = names(color_map),
labels = parse(text = genotype_labels)
) +
ggplot2::guides(fill = ggplot2::guide_legend(label = ggplot2::label_parsed))
} else {
p <- p + ggplot2::scale_fill_manual(values = color_map, breaks = names(color_map))
}
}
if (show_kw_stars && !is.null(kw_only) && nrow(kw_only)) {
y_max <- dn |>
dplyr::group_by(phase) |>
dplyr::summarise(ypos = max(value, na.rm = TRUE) * 1.08, .groups = "drop")
sig_df <- kw_only |>
dplyr::select(phase, label) |>
dplyr::left_join(y_max, by = "phase")
p <- p + ggplot2::geom_text(
data = sig_df,
ggplot2::aes(x = phase, y = ypos, label = label),
inherit.aes = FALSE, vjust = 0, size = 8
)
}
if (show_brackets && nrow(ctrl_vs_mut)) {
genotype_order <- if (!is.null(color_map)) names(color_map) else levels(dn$genotype)
p <- .add_pairwise_brackets_from_build(
p,
stats_df = ctrl_vs_mut,
genotype_order = genotype_order,
y_pad_frac = 0.06,
text_size = 5
)
}
if (is.null(filename)) {
filename <- sprintf("DAM_%s_day_night_box.png", metric)
}
out <- file.path(outdir, filename)
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, stats_ctrl_vs_mut = ctrl_vs_mut, data = dn, file = out, mode = mode))
}
plot_total_sleep_by_day <- function(
df,
sleep_block_min = 5L,
outdir = "DAM_Graphs",
color_map = NULL,
show_legend = TRUE,
# appearance
mean_linewidth = 1.0,
sem_alpha = 0.25,
show_points = FALSE, # <-- NEW: turn day dots on/off
point_size = 2,
# labels
title = NULL,
x_label = "Day",
y_label = NULL,
title_size = 20,
axis_title_size = 20,
axis_text_size = 14,
# day filtering (to avoid clipped/empty days)
drop_empty_days = TRUE, # drop days with 0 real minutes across all tubes
min_real_minutes_per_day = NULL, # e.g., 24*60 to keep only full days per tube
# file
filename = "DAM_sleep_total_by_day.png",
width_in = 7, height_in = 4, dpi = 300
) {
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
# Ensure is_padded exists; older dfs before fill_missing may not have it.
if (!("is_padded" %in% names(df))) df$is_padded <- FALSE
# Per-minute sleep flag (NA/padded minutes break runs, so flagged as 0 by design)
df2 <- df %>%
dplyr::arrange(ts) %>%
dplyr::group_by(genotype, tube) %>%
dplyr::mutate(sleep_flag = flag_sleep_minutes(count, sleep_block_min)) %>%
dplyr::ungroup() %>%
dplyr::mutate(day = as.Date(ts))
# Tube/day totals AND real (non-padded) minutes per tube/day
tube_day <- df2 %>%
dplyr::group_by(genotype, tube, day) %>%
dplyr::summarise(
total_sleep_min = sum(sleep_flag, na.rm = TRUE),
real_minutes = sum(!dplyr::coalesce(is_padded, FALSE)),
.groups = "drop"
)
# (A) Optionally drop tube-days with too few real minutes (e.g., partial days)
if (!is.null(min_real_minutes_per_day)) {
tube_day <- dplyr::filter(tube_day, real_minutes >= as.integer(min_real_minutes_per_day))
}
# (B) Optionally drop entire calendar days that have 0 real minutes across all tubes
if (drop_empty_days) {
keep_days <- tube_day %>%
dplyr::group_by(day) %>%
dplyr::summarise(all_real = sum(real_minutes, na.rm = TRUE) > 0, .groups = "drop") %>%
dplyr::filter(all_real) %>%
dplyr::pull(day)
tube_day <- dplyr::filter(tube_day, day %in% keep_days)
}
# Genotype mean ± SEM per day
geno_day <- tube_day %>%
dplyr::group_by(genotype, day) %>%
dplyr::summarise(
n = dplyr::n(),
mean = mean(total_sleep_min),
sem = stats::sd(total_sleep_min)/sqrt(n),
.groups = "drop"
)
if (is.null(y_label)) {
y_label <- sprintf("Total sleep / day (min, ≥%d-min bouts)", as.integer(sleep_block_min))
}
if (is.null(title)) title <- "DAM: Total Sleep per Day"
p <- ggplot2::ggplot(
geno_day,
ggplot2::aes(x = day, y = mean, color = genotype, fill = genotype, group = genotype)
) +
ggplot2::geom_ribbon(ggplot2::aes(ymin = mean - sem, ymax = mean + sem), alpha = sem_alpha, linewidth = 0) +
ggplot2::geom_line(linewidth = mean_linewidth) +
ggplot2::labs(x = x_label, y = y_label, title = title) +
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
plot.title = ggplot2::element_text(hjust = 0.5, size = title_size),
axis.title.x = ggplot2::element_text(size = axis_title_size),
axis.title.y = ggplot2::element_text(size = axis_title_size),
axis.text = ggplot2::element_text(size = axis_text_size)
)
if (show_points) {
p <- p + ggplot2::geom_point(size = point_size)
}
if (!is.null(color_map)) {
p <- p +
ggplot2::scale_color_manual(values = color_map, labels = genotype_labels) +
ggplot2::scale_fill_manual(values = color_map, labels = genotype_labels) +
ggplot2::guides(
color = ggplot2::guide_legend(label = ggplot2::label_parsed),
fill = ggplot2::guide_legend(label = ggplot2::label_parsed)
)
}
out <- file.path(outdir, filename)
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, summary = geno_day, data = tube_day, file = out))
}
build_daynight_activity_avg <- function(df) {
df %>%
dplyr::mutate(
phase = dplyr::if_else(light == 1L, "Light", "Dark", missing = NA_character_),
day = as.Date(ts),
fly_id = paste(run_id, tube, sep = "_") # ✅ unique fly across experiments
) %>%
dplyr::filter(!is.na(phase)) %>%
dplyr::group_by(genotype, fly_id, phase, day) %>%
dplyr::summarise(total_day = sum(count_na0, na.rm = TRUE), .groups = "drop") %>%
dplyr::group_by(genotype, fly_id, phase) %>%
dplyr::summarise(value = mean(total_day, na.rm = TRUE), days = dplyr::n(), .groups = "drop")
}
build_daynight_sleep_avg <- function(df, sleep_block_min = 5L) {
df %>%
dplyr::arrange(ts) %>%
dplyr::group_by(run_id, genotype, tube) %>% # ✅ include run_id here too
dplyr::mutate(sleep_flag = flag_sleep_minutes(count, sleep_block_min)) %>%
dplyr::ungroup() %>%
dplyr::mutate(
phase = dplyr::if_else(light == 1L, "Light", "Dark", missing = NA_character_),
day = as.Date(ts),
fly_id = paste(run_id, tube, sep = "_") # ✅ unique fly across experiments
) %>%
dplyr::filter(!is.na(phase)) %>%
dplyr::group_by(genotype, fly_id, phase, day) %>%
dplyr::summarise(total_day = sum(sleep_flag, na.rm = TRUE), .groups = "drop") %>%
dplyr::group_by(genotype, fly_id, phase) %>%
dplyr::summarise(value = mean(total_day, na.rm = TRUE), days = dplyr::n(), .groups = "drop")
}
# Minutes from ZT12 to first sleep bout in dark phase, averaged across nights per fly.
# Called by plot_sleep_latency_box (was missing from original script).
build_sleep_latency <- function(df,
zt0_hour = 6L,
sleep_block_min = 5L,
summarize_days = c("mean", "median")) {
summarize_days <- match.arg(summarize_days)
lc <- infer_light_cycle(df, zt0_hour = zt0_hour)
per_day <- lc$per_day
tz_ts <- lubridate::tz(df$ts)
if (is.null(tz_ts) || tz_ts == "") tz_ts <- "UTC"
df2 <- df |>
dplyr::mutate(
day = as.Date(lubridate::with_tz(ts, tz_ts)),
fly_id = dplyr::if_else(
!is.na(run_id) & run_id != "",
paste(run_id, tube, sep = "__"),
as.character(tube)
)
) |>
dplyr::left_join(per_day |> dplyr::select(day, ON), by = "day") |>
dplyr::mutate(
zt_min = as.integer((as.numeric(difftime(ts, ON, units = "mins")) %% (24L * 60L)))
) |>
dplyr::arrange(genotype, fly_id, ts) |>
dplyr::group_by(genotype, fly_id) |>
dplyr::mutate(sleep_flag = flag_sleep_minutes(count, sleep_block_min = sleep_block_min)) |>
dplyr::ungroup()
# Per fly-day: first sleep minute in the dark phase (ZT12 onward)
lat_day <- df2 |>
dplyr::filter(zt_min >= 12L * 60L, sleep_flag == 1L) |>
dplyr::group_by(genotype, fly_id, day) |>
dplyr::summarise(latency_min = min(zt_min, na.rm = TRUE) - 12L * 60L, .groups = "drop")
# Average across nights per fly
lat_day |>
dplyr::group_by(genotype, fly_id) |>
dplyr::summarise(
value = if (summarize_days == "mean") mean(latency_min, na.rm = TRUE)
else stats::median(latency_min, na.rm = TRUE),
.groups = "drop"
)
}
#### Xlsx export helper ####
# Reshapes per-fly data to wide format (one column per genotype) with Mean and SEM appended.
.wide_with_summary <- function(df, value_col = "value", geno_order = NULL) {
if (is.null(geno_order)) geno_order <- sort(unique(df$genotype))
by_geno <- lapply(geno_order, function(g) df[df$genotype == g, value_col, drop = TRUE])
n_max <- max(vapply(by_geno, length, 1L))
wide <- do.call(data.frame,
lapply(by_geno, function(v) c(v, rep(NA_real_, n_max - length(v)))))
names(wide) <- geno_order
means <- vapply(by_geno, function(v) mean(v, na.rm = TRUE), numeric(1))
sems <- vapply(by_geno, function(v) {
n <- sum(!is.na(v)); if (n > 1) stats::sd(v, na.rm = TRUE) / sqrt(n) else NA_real_
}, numeric(1))
summ_df <- rbind(setNames(as.data.frame(t(means)), geno_order),
setNames(as.data.frame(t(sems)), geno_order))
label_col <- data.frame(fly_id = c(paste0("fly_", seq_len(n_max)), "Mean", "SEM"),
stringsAsFactors = FALSE)
cbind(label_col, rbind(wide, summ_df))
}
# Writes one phased metric (Light / Dark sections) to a sheet in wb.
.write_phased_sheet <- function(wb, sheet_name, df, value_col = "value", geno_order = NULL) {
if (is.null(geno_order)) geno_order <- sort(unique(df$genotype))
openxlsx::addWorksheet(wb, sheet_name)
phase_style <- openxlsx::createStyle(textDecoration = "bold", fgFill = "#CFE2F3")
hdr_style <- openxlsx::createStyle(textDecoration = "bold", fgFill = "#D9EAD3",
border = "Bottom")
summ_style <- openxlsx::createStyle(fontColour = "#555555", numFmt = "0.00")
cur_row <- 1L
for (ph in c("Light", "Dark")) {
sub <- df[df$phase == ph, ]
if (nrow(sub) == 0) next
openxlsx::writeData(wb, sheet_name,
data.frame(Phase = ph), startRow = cur_row, startCol = 1,
rowNames = FALSE, colNames = FALSE)
openxlsx::addStyle(wb, sheet_name, phase_style, rows = cur_row, cols = 1)
cur_row <- cur_row + 1L
tbl <- .wide_with_summary(sub, value_col, geno_order)
openxlsx::writeData(wb, sheet_name, tbl, startRow = cur_row, startCol = 1,
rowNames = FALSE, headerStyle = hdr_style)
n_rows <- nrow(tbl)
openxlsx::addStyle(wb, sheet_name, summ_style,
rows = cur_row + n_rows - 1L, cols = seq_len(ncol(tbl)),
stack = TRUE, gridExpand = TRUE)
openxlsx::addStyle(wb, sheet_name, summ_style,
rows = cur_row + n_rows, cols = seq_len(ncol(tbl)),
stack = TRUE, gridExpand = TRUE)
cur_row <- cur_row + n_rows + 1L + 2L # header row + data + blank gap
}
}
# Master export: collects all metric tables from one experiment block and writes S1_Data.xlsx.
export_metrics_xlsx <- function(outdamdir,
res_act,
res_slp,
res_sleep_bouts_n,
res_sleep_boutdur,
res_act_bouts_n,
res_latency,
per,
filename = "S1_Data.xlsx") {
wb <- openxlsx::createWorkbook()
hdr_style <- openxlsx::createStyle(textDecoration = "bold", fgFill = "#D9EAD3",
border = "Bottom")
summ_style <- openxlsx::createStyle(fontColour = "#555555", numFmt = "0.00")
geno_order <- sort(unique(res_act$data$genotype))
# 1. Activity (beam crossings per 12 h, by phase)
.write_phased_sheet(wb, "Activity_beam_crossings", res_act$data, "value", geno_order)
# 2. Sleep duration (min/day, by phase)
.write_phased_sheet(wb, "Sleep_min_per_day", res_slp$data, "value", geno_order)
# 3. Sleep bout count (per 12 h, by phase)
.write_phased_sheet(wb, "Sleep_bout_count", res_sleep_bouts_n$data, "value", geno_order)
# 4. Sleep bout duration (mean min, by phase)
.write_phased_sheet(wb, "Sleep_bout_duration_min", res_sleep_boutdur$data, "value", geno_order)
# 5. Activity bout count (by phase)
.write_phased_sheet(wb, "Activity_bout_count", res_act_bouts_n$data, "value", geno_order)
# 6. Sleep latency (single dark-onset value per fly, no phase split)
openxlsx::addWorksheet(wb, "Sleep_latency_min")
lat_df <- res_latency$data |> dplyr::rename(dplyr::any_of(c(fly_id = "id")))
lat_tbl <- .wide_with_summary(lat_df, "value",
intersect(geno_order, lat_df$genotype))
openxlsx::writeData(wb, "Sleep_latency_min", lat_tbl, startRow = 1, startCol = 1,
rowNames = FALSE, headerStyle = hdr_style)
n_lat <- nrow(lat_tbl)
openxlsx::addStyle(wb, "Sleep_latency_min", summ_style,
rows = n_lat, cols = seq_len(ncol(lat_tbl)), stack = TRUE, gridExpand = TRUE)
openxlsx::addStyle(wb, "Sleep_latency_min", summ_style,
rows = n_lat + 1, cols = seq_len(ncol(lat_tbl)), stack = TRUE, gridExpand = TRUE)
# 7. Circadian period (one value per fly/tube)
openxlsx::addWorksheet(wb, "Circadian_period_h")
per_clean <- per[is.finite(per$period_h), ]
per_tbl <- .wide_with_summary(per_clean, "period_h",
intersect(geno_order, per_clean$genotype))
openxlsx::writeData(wb, "Circadian_period_h", per_tbl, startRow = 1, startCol = 1,
rowNames = FALSE, headerStyle = hdr_style)
n_per <- nrow(per_tbl)
openxlsx::addStyle(wb, "Circadian_period_h", summ_style,
rows = n_per, cols = seq_len(ncol(per_tbl)), stack = TRUE, gridExpand = TRUE)
openxlsx::addStyle(wb, "Circadian_period_h", summ_style,
rows = n_per + 1, cols = seq_len(ncol(per_tbl)), stack = TRUE, gridExpand = TRUE)
out_path <- file.path(outdamdir, filename)
openxlsx::saveWorkbook(wb, out_path, overwrite = TRUE)
message("Metrics xlsx saved: ", out_path)
invisible(out_path)
}
.p_to_stars <- function(p) {
vapply(p, function(x) {
if (is.na(x)) return(NA_character_)
if (x < 1e-4) "****"
else if (x < 1e-3) "***"
else if (x < 1e-2) "**"
else if (x < 5e-2) "*"
else "ns"
}, character(1))
}
.add_pairwise_brackets_from_build <- function(
p,
stats_df,
phase_labels = c(Light = "Day", Dark = "Night"),
genotype_order = NULL, # pass names(color_map) ideally
y_pad_frac = 0.06,
text_size = 5,
drop_ns = TRUE,
# --- NEW controls ---
bracket_anchor = c("top", "box", "fixed"),
bracket_fixed_y = NULL, # used if bracket_anchor == "fixed"
base_lift_mult = 0, # how far BELOW top (in y_step units) when anchor="top"
gap_mult = 1.2 # spacing between stacked brackets (in y_step units)
) {
bracket_anchor <- match.arg(bracket_anchor)
if (!nrow(stats_df)) return(p)
b <- ggplot2::ggplot_build(p)
# Find first layer that looks like a boxplot layer
box_i <- which(vapply(b$data, function(x) all(c("x","upper","lower") %in% names(x)), logical(1)))
if (!length(box_i)) return(p)
boxdat <- b$data[[box_i[1]]]
# base_x: which discrete phase bucket (1,2,...)
boxdat$base_x <- round(boxdat$x)
# Map base_x -> phase factor level names (in the order used by the plot)
phase_levels <- names(phase_labels)
phase_map <- stats::setNames(phase_levels, seq_along(phase_levels))
boxdat$phase <- unname(phase_map[as.character(boxdat$base_x)])
# Determine genotype order to assign within each phase
if (is.null(genotype_order)) {
if (!is.null(p$data$genotype)) {
genotype_order <- levels(factor(p$data$genotype))
} else {
genotype_order <- sort(unique(as.character(p$data$genotype)))
}
}
# Build lookup: for each phase, sort boxes by x and assign genotypes in order
combos <- boxdat %>%
dplyr::filter(!is.na(phase)) %>%
dplyr::group_by(phase) %>%
dplyr::arrange(x, .by_group = TRUE) %>%
dplyr::mutate(genotype = genotype_order[seq_len(dplyr::n())]) %>%
dplyr::ungroup() %>%
dplyr::select(phase, genotype, x, upper) %>%
dplyr::rename(ymax_box = upper)
# Phase-wise y-top from the drawn boxes
y_top <- combos %>%
dplyr::group_by(phase) %>%
dplyr::summarise(y_top = max(ymax_box, na.rm = TRUE), .groups = "drop")
# Parse comparison "A vs B"
stats_df2 <- stats_df %>%
dplyr::mutate(
p_use = dplyr::coalesce(.data$p_adj, .data$p),
label = .p_to_stars(p_use),
g1 = sub(" vs .*", "", comparison),
g2 = sub(".* vs ", "", comparison)
) %>%
dplyr::left_join(y_top, by = "phase")
# Drop ns labels if requested
if (drop_ns) {
stats_df2 <- stats_df2 %>% dplyr::filter(!is.na(label), label != "ns")
}
if (!nrow(stats_df2)) return(p)
# Stack brackets within each phase
yrng <- ggplot2::layer_scales(p)$y$range$range
y_span <- diff(yrng)
if (!is.finite(y_span) || y_span == 0) y_span <- 1
y_step <- y_span * y_pad_frac
stats_df2 <- stats_df2 %>%
dplyr::group_by(phase) %>%
dplyr::arrange(p_use, .by_group = TRUE) %>% # smaller p first (optional)
dplyr::mutate(rank_in_phase = dplyr::row_number()) %>%
dplyr::ungroup()
# Choose anchor
if (bracket_anchor == "top") {
# anchor a bit BELOW the top of the y-range
y_anchor <- yrng[2] - base_lift_mult * y_step
} else if (bracket_anchor == "fixed") {
if (is.null(bracket_fixed_y) || !is.finite(bracket_fixed_y)) {
stop("bracket_fixed_y must be a finite number when bracket_anchor = 'fixed'")
}
y_anchor <- bracket_fixed_y
} else {
# "box": anchor above the highest box in each phase (old behavior),
# but still give it a lift so it clears whiskers
# We'll compute per-phase anchor below when making 'ann'
y_anchor <- NA_real_
}
# Join x positions for each genotype within phase
ann <- stats_df2 %>%
dplyr::left_join(
combos %>% dplyr::select(phase, genotype, x),
by = c("phase", "g1" = "genotype")
) %>%
dplyr::rename(x1 = x) %>%
dplyr::left_join(
combos %>% dplyr::select(phase, genotype, x),
by = c("phase", "g2" = "genotype")
) %>%
dplyr::rename(x2 = x) %>%
dplyr::mutate(
x_min = pmin(x1, x2),
x_max = pmax(x1, x2),
y = dplyr::case_when(
bracket_anchor == "top" ~ y_anchor + (rank_in_phase - 1) * y_step * gap_mult,
bracket_anchor == "fixed" ~ y_anchor + (rank_in_phase - 1) * y_step * gap_mult,
TRUE ~ (y_top + 1.2 * y_step) + (rank_in_phase - 1) * y_step * gap_mult # "box"
)
) %>%
dplyr::filter(is.finite(x_min), is.finite(x_max), phase %in% phase_levels)
if (!nrow(ann)) return(p)
# Draw brackets + stars
p +
ggplot2::geom_segment(
data = ann,
ggplot2::aes(x = x_min, xend = x_max, y = y, yend = y),
inherit.aes = FALSE, linewidth = 0.6
) +
ggplot2::geom_segment(
data = ann,
ggplot2::aes(x = x_min, xend = x_min, y = y, yend = y - 0.25 * y_step),
inherit.aes = FALSE, linewidth = 0.6
) +
ggplot2::geom_segment(
data = ann,
ggplot2::aes(x = x_max, xend = x_max, y = y, yend = y - 0.25 * y_step),
inherit.aes = FALSE, linewidth = 0.6
) +
ggplot2::geom_text(
data = ann,
ggplot2::aes(x = (x_min + x_max) / 2, y = y + 0.15 * y_step, label = label),
inherit.aes = FALSE, size = text_size
)
}
pairwise_vs_mutant_by_phase <- function(df_long, value_col = "value",
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
p_adjust = "BH") {
stopifnot(all(c("genotype","phase", value_col) %in% names(df_long)))
out <- df_long %>%
dplyr::filter(genotype %in% c(mutant, controls)) %>%
dplyr::group_by(phase) %>%
dplyr::group_modify(\(d, key) {
res <- lapply(controls, function(ctrl) {
s2 <- d %>% dplyr::filter(genotype %in% c(ctrl, mutant))
p <- tryCatch(
stats::wilcox.test(s2[[value_col]] ~ s2$genotype, exact = FALSE)$p.value,
error = function(e) NA_real_
)
tibble::tibble(
test = "Wilcoxon (control vs mutant)",
comparison = paste(ctrl, "vs", mutant),
p = p
)
})
dplyr::bind_rows(res)
}) %>%
dplyr::ungroup()
out$p_adj <- p.adjust(out$p, method = p_adjust)
out
}
plot_daynight_activity_box <- function(
df, outdir = "DAM_Graphs",
color_map = NULL,
genotype_labels = NULL, # named vector of plotmath strings
legend_text_size = 14,
legend_title_size = 0,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = TRUE,
show_dots = TRUE,
dot_size = 0.8,
show_kw_stars = FALSE, # <- default OFF (you usually don't want KW across all 3)
show_brackets = TRUE, # control-vs-mutant brackets
drop_ns = TRUE, # don't draw ns labels/brackets
# text controls
title = NULL,
x_label = NULL,
y_label = NULL,
phase_labels = c(Light = "Day", Dark = "Night"),
width_in = 4, height_in = 4, dpi = 300
) {
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
# ---- data (per-fly across runs) ----
dn <- build_daynight_activity_avg(df)
# stable ordering
dn$phase <- factor(dn$phase, levels = names(phase_labels))
if (!is.null(color_map)) dn$genotype <- factor(dn$genotype, levels = names(color_map))
# ---- stats for brackets (only ctrl vs mutant) ----
ctrl_vs_mut <- pairwise_vs_mutant_by_phase(
dn, value_col = "value",
mutant = mutant, controls = controls,
p_adjust = "BH"
) %>%
dplyr::mutate(
p_use = dplyr::coalesce(p_adj, p),
label = .p_to_stars(p_use)
)
if (drop_ns) {
ctrl_vs_mut <- ctrl_vs_mut %>% dplyr::filter(!is.na(label), label != "ns")
}
# ---- optional KW per phase (rarely needed) ----
kw_only <- NULL
if (show_kw_stars) {
kw_only <- nonparam_stats_by_phase(dn, value_col = "value", p_adjust = "BH") %>%
dplyr::filter(test == "Kruskal–Wallis") %>%
dplyr::mutate(label = .p_to_stars(p)) %>%
{ if (drop_ns) dplyr::filter(., label != "ns") else . }
}
default_title <- "Activity"
default_y <- "Beam crossings per day"
default_x <- NULL
p <- ggplot2::ggplot(dn, ggplot2::aes(x = phase, y = value, fill = genotype)) +
ggplot2::geom_boxplot(
position = ggplot2::position_dodge(width = 0.6),
width = 0.6, alpha = 0.9, outlier.shape = NA
) +
ggplot2::labs(
x = if (is.null(x_label)) default_x else x_label,
y = if (is.null(y_label)) default_y else y_label,
title = if (is.null(title)) default_title else title
) +
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
legend.text = ggplot2::element_text(size = legend_text_size),
legend.title = ggplot2::element_text(size = legend_title_size),
plot.title = ggplot2::element_text(hjust = 0.5, size = 26),
axis.title.y = ggplot2::element_text(size = 20),
axis.text = ggplot2::element_text(size = 14),
# helps avoid clipping of annotations
plot.margin = ggplot2::margin(t = 12, r = 10, b = 6, l = 6)
) +
ggplot2::scale_x_discrete(labels = phase_labels) +
ggplot2::scale_y_continuous(limits = c(0, NA),expand = ggplot2::expansion(mult = c(0, 0.18))) +
# ggplot2::scale_y_continuous(expand = ggplot2::expansion(mult = c(0.02, 0.18))) +
ggplot2::coord_cartesian(clip = "off")
if (show_dots) {
p <- p + ggplot2::geom_point(
ggplot2::aes(color = NULL),
position = ggplot2::position_jitterdodge(jitter.width = 0.04, dodge.width = 0.6),
size = dot_size, alpha = 0.6, shape = 16, color = "black"
)
}
# ---- fill scale + parsed legend labels ----
if (!is.null(color_map)) {
if (!is.null(genotype_labels)) {
genotype_labels <- genotype_labels[names(color_map)]
p <- p +
ggplot2::scale_fill_manual(
values = color_map,
breaks = names(color_map),
labels = parse(text = genotype_labels)
) +
ggplot2::guides(
fill = ggplot2::guide_legend(label = ggplot2::label_parsed)
)
} else {
p <- p + ggplot2::scale_fill_manual(values = color_map, breaks = names(color_map))
}
}
# ---- (A) KW stars above each phase (optional) ----
if (show_kw_stars && !is.null(kw_only) && nrow(kw_only)) {
y_max <- dn %>%
dplyr::group_by(phase) %>%
dplyr::summarise(ypos = max(value, na.rm = TRUE) * 1.08, .groups = "drop")
sig_df <- kw_only %>%
dplyr::select(phase, label) %>%
dplyr::left_join(y_max, by = "phase")
p <- p + ggplot2::geom_text(
data = sig_df,
ggplot2::aes(x = phase, y = ypos, label = label),
inherit.aes = FALSE, vjust = 0, size = 8
)
}
# ---- (B) ctrl vs mutant brackets (significant only) ----
if (show_brackets && nrow(ctrl_vs_mut)) {
genotype_order <- if (!is.null(color_map)) names(color_map) else levels(dn$genotype)
p <- .add_pairwise_brackets_from_build(
p,
stats_df = ctrl_vs_mut,
genotype_order = genotype_order,
y_pad_frac = 0.06,
text_size = 5
)
}
out <- file.path(outdir, "DAM_activity_day_night_box.png")
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, stats_ctrl_vs_mut = ctrl_vs_mut, data = dn, file = out))
}
plot_daynight_sleep_box <- function(
df, sleep_block_min = 5L,
outdir = "DAM_Graphs",
color_map = NULL,
genotype_labels = NULL, # named vector of plotmath strings
legend_text_size = 14,
legend_title_size = 0,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = TRUE,
show_dots = TRUE,
dot_size = 0.8,
show_kw_stars = FALSE, # default OFF
show_brackets = TRUE, # control-vs-mutant brackets
drop_ns = TRUE, # don't draw ns labels/brackets
# text controls
title = NULL,
x_label = NULL,
y_label = NULL,
phase_labels = c(Light = "Day", Dark = "Night"),
width_in = 4, height_in = 4, dpi = 300
) {
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
# ---- data (per-fly across runs) ----
dn <- build_daynight_sleep_avg(df, sleep_block_min = sleep_block_min)
# stable ordering
dn$phase <- factor(dn$phase, levels = names(phase_labels))
if (!is.null(color_map)) dn$genotype <- factor(dn$genotype, levels = names(color_map))
# ---- stats for brackets (only ctrl vs mutant) ----
ctrl_vs_mut <- pairwise_vs_mutant_by_phase(
dn, value_col = "value",
mutant = mutant, controls = controls,
p_adjust = "BH"
) %>%
dplyr::mutate(
p_use = dplyr::coalesce(p_adj, p),
label = .p_to_stars(p_use)
)
if (drop_ns) {
ctrl_vs_mut <- ctrl_vs_mut %>% dplyr::filter(!is.na(label), label != "ns")
}
# ---- optional KW per phase (rarely needed) ----
kw_only <- NULL
if (show_kw_stars) {
kw_only <- nonparam_stats_by_phase(dn, value_col = "value", p_adjust = "BH") %>%
dplyr::filter(test == "Kruskal–Wallis") %>%
dplyr::mutate(label = .p_to_stars(p)) %>%
{ if (drop_ns) dplyr::filter(., label != "ns") else . }
}
default_title <- "Sleep"
default_y <- sprintf("Sleep (min/day; ≥%d-min bouts)", as.integer(sleep_block_min))
default_x <- NULL
p <- ggplot2::ggplot(dn, ggplot2::aes(x = phase, y = value, fill = genotype)) +
ggplot2::geom_boxplot(
position = ggplot2::position_dodge(width = 0.6),
width = 0.6, alpha = 0.9, outlier.shape = NA
) +
ggplot2::labs(
x = if (is.null(x_label)) default_x else x_label,
y = if (is.null(y_label)) default_y else y_label,
title = if (is.null(title)) default_title else title
) +
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
legend.text = ggplot2::element_text(size = legend_text_size),
legend.title = ggplot2::element_text(size = legend_title_size),
plot.title = ggplot2::element_text(hjust = 0.5, size = 26),
axis.title.y = ggplot2::element_text(size = 20),
axis.text = ggplot2::element_text(size = 14),
plot.margin = ggplot2::margin(t = 12, r = 10, b = 6, l = 6)
) +
ggplot2::scale_x_discrete(labels = phase_labels) +
ggplot2::scale_y_continuous(limits = c(0, NA),expand = ggplot2::expansion(mult = c(0, 0.18))) +
# ggplot2::scale_y_continuous(expand = ggplot2::expansion(mult = c(0.02, 0.18))) +
ggplot2::coord_cartesian(clip = "off")
if (show_dots) {
p <- p + ggplot2::geom_point(
ggplot2::aes(color = NULL),
position = ggplot2::position_jitterdodge(jitter.width = 0.04, dodge.width = 0.6),
size = dot_size, alpha = 0.6, shape = 16, color = "black"
)
}
# ---- fill scale + parsed legend labels ----
if (!is.null(color_map)) {
if (!is.null(genotype_labels)) {
genotype_labels <- genotype_labels[names(color_map)]
p <- p +
ggplot2::scale_fill_manual(
values = color_map,
breaks = names(color_map),
labels = parse(text = genotype_labels)
) +
ggplot2::guides(
fill = ggplot2::guide_legend(label = ggplot2::label_parsed)
)
} else {
p <- p + ggplot2::scale_fill_manual(values = color_map, breaks = names(color_map))
}
}
# ---- (A) KW stars above each phase (optional) ----
if (show_kw_stars && !is.null(kw_only) && nrow(kw_only)) {
y_max <- dn %>%
dplyr::group_by(phase) %>%
dplyr::summarise(ypos = max(value, na.rm = TRUE) * 1.08, .groups = "drop")
sig_df <- kw_only %>%
dplyr::select(phase, label) %>%
dplyr::left_join(y_max, by = "phase")
p <- p + ggplot2::geom_text(
data = sig_df,
ggplot2::aes(x = phase, y = ypos, label = label),
inherit.aes = FALSE, vjust = 0, size = 8
)
}
# ---- (B) ctrl vs mutant brackets (significant only) ----
if (show_brackets && nrow(ctrl_vs_mut)) {
genotype_order <- if (!is.null(color_map)) names(color_map) else levels(dn$genotype)
p <- .add_pairwise_brackets_from_build(
p,
stats_df = ctrl_vs_mut,
genotype_order = genotype_order,
y_pad_frac = 0.06,
text_size = 5,
drop_ns = drop_ns
)
}
out <- file.path(outdir, "DAM_sleep_day_night_box.png")
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(
plot = p,
stats_ctrl_vs_mut = ctrl_vs_mut,
data = dn,
file = out
))
}
# Per-tube day/night totals for activity
build_daynight_activity <- function(df) {
df %>%
dplyr::mutate(phase = dplyr::if_else(light == 1L, "Light", "Dark", missing = NA_character_)) %>%
dplyr::filter(!is.na(phase)) %>%
dplyr::group_by(genotype, tube, phase) %>%
dplyr::summarise(total = sum(count_na0, na.rm = TRUE), .groups = "drop")
}
# Per-tube day/night totals for sleep (≥ sleep_block_min consecutive zeros)
flag_sleep_minutes <- function(count, sleep_block_min = 5L) {
is_zero <- (!is.na(count)) & (count == 0L)
r <- rle(is_zero); idx <- rep.int(seq_along(r$lengths), r$lengths)
as.integer(is_zero & (r$lengths[idx] >= as.integer(sleep_block_min)))
}
build_daynight_sleep <- function(df, sleep_block_min = 5L) {
df %>%
dplyr::arrange(ts) %>%
dplyr::group_by(genotype, tube) %>%
dplyr::mutate(sleep_flag = flag_sleep_minutes(count, sleep_block_min)) %>%
dplyr::ungroup() %>%
dplyr::mutate(phase = dplyr::if_else(light == 1L, "Light", "Dark", missing = NA_character_)) %>%
dplyr::filter(!is.na(phase)) %>%
dplyr::group_by(genotype, tube, phase) %>%
dplyr::summarise(total = sum(sleep_flag, na.rm = TRUE), .groups = "drop")
}
# Simple nonparametric stats:
# - If 2 genotypes: Wilcoxon (Mann–Whitney) per phase
# - If >2 genotypes: Kruskal–Wallis per phase; then pairwise Wilcoxon with BH correction
nonparam_stats_by_phase <- function(df_long, value_col = "total", p_adjust = "BH") {
stopifnot(all(c("genotype","phase", value_col) %in% names(df_long)))
phases <- sort(unique(df_long$phase))
out_list <- list()
for (ph in phases) {
sub <- df_long[df_long$phase == ph, , drop = FALSE]
k <- length(unique(sub$genotype))
if (k == 2) {
g <- unique(sub$genotype)
p <- tryCatch(
stats::wilcox.test(sub[[value_col]] ~ sub$genotype, exact = FALSE)$p.value,
error = function(e) NA_real_
)
out_list[[ph]] <- data.frame(
phase = ph, test = "Wilcoxon rank-sum",
comparison = paste(g, collapse = " vs "), p = p,
p_adj = NA_real_, # <- keep columns consistent
stringsAsFactors = FALSE
)
} else if (k > 2) {
kw <- tryCatch(stats::kruskal.test(sub[[value_col]] ~ sub$genotype), error = function(e) NULL)
row_kw <- data.frame(
phase = ph, test = "Kruskal–Wallis",
comparison = "all groups",
p = if (is.null(kw)) NA_real_ else kw$p.value,
p_adj = NA_real_, # <- add p_adj here
stringsAsFactors = FALSE
)
pairs <- utils::combn(sort(unique(sub$genotype)), 2, simplify = FALSE)
pw <- lapply(pairs, function(pp) {
s2 <- sub[sub$genotype %in% pp, , drop = FALSE]
p <- tryCatch(
stats::wilcox.test(s2[[value_col]] ~ s2$genotype, exact = FALSE)$p.value,
error = function(e) NA_real_
)
data.frame(
phase = ph, test = "Wilcoxon pairwise",
comparison = paste(pp, collapse = " vs "), p = p,
stringsAsFactors = FALSE
)
})
pw <- do.call(rbind, pw)
pw$p_adj <- p.adjust(pw$p, method = p_adjust)
out_list[[ph]] <- rbind(row_kw, pw) # now columns match
}
}
do.call(rbind, out_list)
}
.dodge_w <- 0.6
.jitter_w <- 0.04
.tag_zt_day <- function(df, tz = "America/Los_Angeles") {
lc <- try(infer_light_cycle(df), silent = TRUE)
per_day <- if (inherits(lc, "try-error")) NULL else lc$per_day
med_on <- if (inherits(lc, "try-error")) NA else lc$summary$lights_on_median
# Fallback if infer_light_cycle couldn't determine ON/OFF medians
if (is.null(per_day) || !is.finite(as.numeric(med_on))) {
# median time-of-day among rows with light==1
df_on <- dplyr::filter(df, light == 1L, !is.na(ts))
if (nrow(df_on)) {
tod <- as.POSIXct(format(df_on$ts, "%H:%M:%S"), format = "%H:%M:%S", tz = tz)
med_tod <- stats::median(tod, na.rm = TRUE)
# function: given a date, build that day's ON at the median time-of-day
build_on <- function(d) {
as.POSIXct(sprintf("%s %s", as.character(d), format(med_tod, "%H:%M:%S")),
tz = tz)
}
} else {
# last-resort: 09:00 local
build_on <- function(d) {
as.POSIXct(sprintf("%s 09:00:00", as.character(d)), tz = tz)
}
}
df %>%
dplyr::mutate(date = as.Date(ts)) %>%
dplyr::mutate(ON = build_on(date)) %>%
dplyr::mutate(
zt_anchor = dplyr::if_else(ts < ON, ON - lubridate::days(1), ON),
zt_day_id = as.Date(zt_anchor)
) %>%
dplyr::select(-date, -ON)
} else {
# Normal path with per_day ON table and median fallback
df %>%
dplyr::mutate(date = as.Date(ts)) %>%
dplyr::left_join(per_day %>% dplyr::select(day, ON), by = c("date" = "day")) %>%
dplyr::mutate(ON = dplyr::coalesce(ON, med_on)) %>%
dplyr::mutate(
zt_anchor = dplyr::if_else(ts < ON, ON - lubridate::days(1), ON),
zt_day_id = as.Date(zt_anchor)
) %>%
dplyr::select(-date, -ON)
}
}
plot_total_sleep_by_day <- function(
df, sleep_block_min = 5L, outdir = "DAM_Graphs",
color_map = NULL, show_legend = TRUE,
# appearance
mean_linewidth = 1.0, sem_alpha = 0.25, show_points = FALSE, point_size = 2,
# labels
title = NULL, x_label = NULL, y_label = NULL,
title_size = 32, axis_title_size = 18, axis_text_size = 18,
# day choices
day_mode = c("zt","calendar"),
x_mode = c("relative","date"),
# filtering
drop_empty_days = TRUE,
min_real_minutes_per_day = NULL,
# file
filename = "DAM_sleep_total_by_day.png",
width_in = 7, height_in = 4, dpi = 300
) {
day_mode <- match.arg(day_mode)
x_mode <- match.arg(x_mode)
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
if (!("is_padded" %in% names(df))) df$is_padded <- FALSE
df2 <- df %>%
dplyr::arrange(ts) %>%
dplyr::group_by(genotype, tube) %>%
dplyr::mutate(sleep_flag = flag_sleep_minutes(count, sleep_block_min)) %>%
dplyr::ungroup()
# choose the day key
if (day_mode == "zt") df2 <- .tag_zt_day(df2) %>% dplyr::mutate(day_key = zt_day_id)
else df2 <- df2 %>% dplyr::mutate(day_key = as.Date(ts))
# per-tube per-day totals + real minutes (vectorized)
tube_day <- df2 %>%
dplyr::group_by(genotype, tube, day_key) %>%
dplyr::summarise(
total_sleep_min = sum(sleep_flag, na.rm = TRUE),
real_minutes = sum(!dplyr::coalesce(is_padded, FALSE)),
.groups = "drop"
)
if (!is.null(min_real_minutes_per_day)) {
tube_day <- dplyr::filter(tube_day, real_minutes >= as.integer(min_real_minutes_per_day))
}
if (drop_empty_days) {
keep_days <- tube_day %>%
dplyr::group_by(day_key) %>%
dplyr::summarise(any_real = sum(real_minutes, na.rm = TRUE) > 0, .groups = "drop") %>%
dplyr::filter(any_real) %>% dplyr::pull(day_key)
tube_day <- dplyr::filter(tube_day, day_key %in% keep_days)
}
geno_day <- tube_day %>%
dplyr::group_by(genotype, day_key) %>%
dplyr::summarise(n = dplyr::n(),
mean = mean(total_sleep_min),
sem = stats::sd(total_sleep_min)/sqrt(n),
.groups = "drop")
if (is.null(y_label)) y_label <- sprintf("Total sleep / day (min, ≥%d-min bouts)", as.integer(sleep_block_min))
if (is.null(title)) title <- if (day_mode == "zt") "DAM: Total Sleep per ZT Day" else "DAM: Total Sleep per Calendar Day"
if (is.null(x_label)) x_label <- if (x_mode == "relative") "Day" else "Day"
# relative-day mapping 1..N
day_levels <- sort(unique(geno_day$day_key))
day_map <- setNames(seq_along(day_levels), day_levels)
geno_day <- geno_day %>% dplyr::mutate(rel_day = day_map[as.character(day_key)])
# plot
if (x_mode == "relative") {
p <- ggplot2::ggplot(geno_day, ggplot2::aes(x = rel_day, y = mean, color = genotype, fill = genotype, group = genotype)) +
ggplot2::scale_x_continuous(breaks = sort(unique(geno_day$rel_day)))
} else {
p <- ggplot2::ggplot(geno_day, ggplot2::aes(x = day_key, y = mean, color = genotype, fill = genotype, group = genotype))
}
p <- p +
ggplot2::geom_ribbon(ggplot2::aes(ymin = mean - sem, ymax = mean + sem), alpha = sem_alpha, linewidth = 0) +
ggplot2::geom_line(linewidth = mean_linewidth) +ylim(0,NA)+
ggplot2::labs(x = x_label, y = y_label, title = title) +
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
plot.title = ggplot2::element_text(hjust = 0.5, size = title_size),
axis.title.x = ggplot2::element_text(size = axis_title_size),
axis.title.y = ggplot2::element_text(size = axis_title_size),
axis.text = ggplot2::element_text(size = axis_text_size)
)
if (show_points) p <- p + ggplot2::geom_point(size = point_size)
if (!is.null(color_map)) p <- p + ggplot2::scale_color_manual(values = color_map) +
ggplot2::scale_fill_manual(values = color_map)
out <- file.path(outdir, filename)
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, summary = geno_day, data = tube_day, file = out))
}
plot_total_activity_by_day <- function(
df, outdir = "DAM_Graphs",
color_map = NULL, show_legend = TRUE,
# appearance
mean_linewidth = 1.0, sem_alpha = 0.25, show_points = FALSE, point_size = 2,
# labels
title = NULL, x_label = NULL, y_label = "Total activity / day (counts)",
title_size = 32, axis_title_size = 18, axis_text_size = 18,
# day choices
day_mode = c("zt","calendar"),
x_mode = c("relative","date"),
# filtering
drop_empty_days = TRUE,
min_real_minutes_per_day = NULL,
# file
filename = "DAM_activity_total_by_day.png",
width_in = 7, height_in = 4, dpi = 300
) {
day_mode <- match.arg(day_mode)
x_mode <- match.arg(x_mode)
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
if (!("is_padded" %in% names(df))) df$is_padded <- FALSE
df2 <- if (day_mode == "zt") .tag_zt_day(df) %>% dplyr::mutate(day_key = zt_day_id)
else df %>% dplyr::mutate(day_key = as.Date(ts))
tube_day <- df2 %>%
dplyr::group_by(genotype, tube, day_key) %>%
dplyr::summarise(
total_activity = sum(count_na0, na.rm = TRUE),
real_minutes = sum(!dplyr::coalesce(is_padded, FALSE)),
.groups = "drop"
)
if (!is.null(min_real_minutes_per_day)) {
tube_day <- dplyr::filter(tube_day, real_minutes >= as.integer(min_real_minutes_per_day))
}
if (drop_empty_days) {
keep_days <- tube_day %>%
dplyr::group_by(day_key) %>%
dplyr::summarise(any_real = sum(real_minutes, na.rm = TRUE) > 0, .groups = "drop") %>%
dplyr::filter(any_real) %>% dplyr::pull(day_key)
tube_day <- dplyr::filter(tube_day, day_key %in% keep_days)
}
geno_day <- tube_day %>%
dplyr::group_by(genotype, day_key) %>%
dplyr::summarise(n = dplyr::n(),
mean = mean(total_activity),
sem = stats::sd(total_activity)/sqrt(n),
.groups = "drop")
if (is.null(title)) title <- if (day_mode == "zt") "DAM: Total Activity per ZT Day" else "DAM: Total Activity per Calendar Day"
if (is.null(x_label)) x_label <- if (x_mode == "relative") "Day" else "Day"
# relative-day mapping 1..N
day_levels <- sort(unique(geno_day$day_key))
day_map <- setNames(seq_along(day_levels), day_levels)
geno_day <- geno_day %>% dplyr::mutate(rel_day = day_map[as.character(day_key)])
# plot
if (x_mode == "relative") {
p <- ggplot2::ggplot(geno_day, ggplot2::aes(x = rel_day, y = mean, color = genotype, fill = genotype, group = genotype)) +
ggplot2::scale_x_continuous(breaks = sort(unique(geno_day$rel_day)))
} else {
p <- ggplot2::ggplot(geno_day, ggplot2::aes(x = day_key, y = mean, color = genotype, fill = genotype, group = genotype))
}
p <- p +
ggplot2::geom_ribbon(ggplot2::aes(ymin = mean - sem, ymax = mean + sem), alpha = sem_alpha, linewidth = 0) +
ggplot2::geom_line(linewidth = mean_linewidth) +
ggplot2::labs(x = x_label, y = y_label, title = title) +ylim(0,NA)+
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
plot.title = ggplot2::element_text(hjust = 0.5, size = title_size),
axis.title.x = ggplot2::element_text(size = axis_title_size),
axis.title.y = ggplot2::element_text(size = axis_title_size),
axis.text = ggplot2::element_text(size = axis_text_size)
)
if (show_points) p <- p + ggplot2::geom_point(size = point_size)
if (!is.null(color_map)) p <- p + ggplot2::scale_color_manual(values = color_map) +
ggplot2::scale_fill_manual(values = color_map)
out <- file.path(outdir, filename)
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, summary = geno_day, data = tube_day, file = out))
}
#### bout functions ####
.extract_bouts <- function(flag_vec) {
f <- as.integer(flag_vec)
f[is.na(f)] <- 0L
r <- rle(f)
ends <- cumsum(r$lengths)
starts <- ends - r$lengths + 1L
idx <- which(r$values == 1L)
if (!length(idx)) {
return(tibble::tibble(start_idx = integer(), end_idx = integer(), dur_min = integer()))
}
tibble::tibble(
start_idx = starts[idx],
end_idx = ends[idx],
dur_min = r$lengths[idx]
)
}
build_daynight_bout_metric <- function(df,
metric = c("sleep","activity"),
what = c("count","duration"),
zt0_hour = 6L,
sleep_block_min = 5L,
activity_threshold = 0L,
summarize_days = c("mean","median")) {
metric <- match.arg(metric)
what <- match.arg(what)
summarize_days <- match.arg(summarize_days)
lc <- infer_light_cycle(df, zt0_hour = zt0_hour)
per_day <- lc$per_day
mode <- lc$mode
tz_ts <- lubridate::tz(df$ts)
if (is.null(tz_ts) || tz_ts == "") tz_ts <- "UTC"
df2 <- df |>
dplyr::mutate(
day = as.Date(lubridate::with_tz(ts, tz_ts)),
fly_id = dplyr::if_else(
!is.na(run_id) & run_id != "",
paste(run_id, tube, sep = "__"),
as.character(tube)
)
) |>
dplyr::left_join(per_day |> dplyr::select(day, ON), by = "day") |>
dplyr::mutate(
zt_min = as.integer((as.numeric(difftime(ts, ON, units = "mins")) %% (24*60))),
phase = dplyr::if_else(zt_min < 12*60, "Light", "Dark")
) |>
dplyr::arrange(genotype, fly_id, ts)
# per-minute "in-bout" flag
if (metric == "sleep") {
df2 <- df2 |>
dplyr::group_by(genotype, fly_id) |>
dplyr::mutate(flag = flag_sleep_minutes(count, sleep_block_min = sleep_block_min)) |>
dplyr::ungroup()
} else {
df2 <- df2 |>
dplyr::mutate(
count0 = dplyr::coalesce(count_na0, dplyr::coalesce(count, 0)),
flag = count0 > activity_threshold
)
}
# per fly x day x phase
day_phase <- df2 |>
dplyr::group_by(genotype, fly_id, day, phase) |>
dplyr::summarise(
value = {
bouts <- .extract_bouts(flag)
if (what == "count") {
nrow(bouts)
} else {
if (nrow(bouts) == 0) NA_real_ else mean(bouts$dur_min)
}
},
.groups = "drop"
)
# collapse across days (per fly x phase)
dn <- day_phase |>
dplyr::group_by(genotype, fly_id, phase) |>
dplyr::summarise(
value = if (summarize_days == "mean") mean(value, na.rm = TRUE) else stats::median(value, na.rm = TRUE),
.groups = "drop"
)
attr(dn, "mode") <- mode
attr(dn, "metric") <- metric
attr(dn, "what") <- what
dn
}
plot_sleep_latency_box <- function(df,
zt0_hour = 6L,
sleep_block_min = 5L,
summarize_days = c("mean","median"),
outdir = "DAM_Graphs",
filename = NULL,
color_map = NULL,
genotype_labels = NULL,
title = "Sleep latency",
y_label = "Minutes after ZT12 / CT12",
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = TRUE,
show_dots = TRUE,
dot_size = 0.8,
drop_ns = TRUE,
show_brackets = TRUE,
width_in = 4, height_in = 4, dpi = 300) {
summarize_days <- match.arg(summarize_days)
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
dn <- build_sleep_latency(
df,
zt0_hour = zt0_hour,
sleep_block_min = sleep_block_min,
summarize_days = summarize_days
)
# dn should have: genotype, fly_id (or tube), value
id_col <- if ("fly_id" %in% names(dn)) "fly_id" else if ("tube" %in% names(dn)) "tube" else NULL
if (is.null(id_col)) stop("build_sleep_latency() output missing an ID column (expected fly_id or tube).")
d <- dn |>
dplyr::filter(is.finite(value)) |>
dplyr::transmute(genotype, id = .data[[id_col]], value)
# stable ordering
if (!is.null(color_map)) d$genotype <- factor(d$genotype, levels = names(color_map))
# stats via phase helper by adding dummy phase
d_phase <- d |> dplyr::mutate(phase = "All")
ctrl_vs_mut <- pairwise_vs_mutant_by_phase(
d_phase,
value_col = "value",
mutant = mutant,
controls = controls,
p_adjust = "BH"
) |>
dplyr::mutate(
p_use = dplyr::coalesce(p_adj, p),
label = vapply(p_use, .p_to_stars, character(1))
)
if (drop_ns) ctrl_vs_mut <- ctrl_vs_mut |> dplyr::filter(!is.na(label), label != "ns")
# plot
p <- ggplot2::ggplot(d, ggplot2::aes(x = genotype, y = value, fill = genotype)) +
ggplot2::geom_boxplot(width = 0.6, alpha = 0.9, outlier.shape = NA) +
ggplot2::labs(x = NULL, y = y_label, title = title) +
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
legend.text = ggplot2::element_text(size = 14),
legend.title = ggplot2::element_text(size = 0),
plot.title = ggplot2::element_text(hjust = 0.5, size = 26),
axis.title.y = ggplot2::element_text(size = 20),
axis.text = ggplot2::element_text(size = 14),
axis.text.x = ggplot2::element_text(angle = 45, hjust = 1, vjust = 1),
plot.margin = ggplot2::margin(t = 12, r = 10, b = 6, l = 6)
) +
ggplot2::scale_y_continuous(limits = c(0, NA),
expand = ggplot2::expansion(mult = c(0, 0.18))) +
ggplot2::coord_cartesian(clip = "off")
if (show_dots) {
p <- p + ggplot2::geom_point(
position = ggplot2::position_jitter(width = 0.10, height = 0),
size = dot_size, alpha = 0.6, shape = 16, color = "black",
show.legend = FALSE
)
}
# colors + parsed x-axis labels
if (!is.null(color_map)) {
if (!is.null(genotype_labels)) {
genotype_labels <- genotype_labels[names(color_map)]
p <- p +
ggplot2::scale_fill_manual(
values = color_map,
breaks = names(color_map),
labels = parse(text = genotype_labels)
) +
ggplot2::scale_x_discrete(
breaks = names(color_map),
labels = parse(text = genotype_labels)
) +
ggplot2::guides(fill = ggplot2::guide_legend(label = ggplot2::label_parsed))
} else {
p <- p + ggplot2::scale_fill_manual(values = color_map, breaks = names(color_map))
}
} else if (!is.null(genotype_labels)) {
p <- p + ggplot2::scale_x_discrete(
breaks = names(genotype_labels),
labels = parse(text = genotype_labels)
)
}
# brackets (stats has phase="All")
if (show_brackets && nrow(ctrl_vs_mut)) {
genotype_order <- if (!is.null(color_map)) names(color_map) else levels(factor(d$genotype))
p <- .add_pairwise_brackets_from_build(
p,
stats_df = ctrl_vs_mut,
genotype_order = genotype_order,
y_pad_frac = 0.06,
text_size = 5
)
}
if (is.null(filename)) filename <- "DAM_sleep_latency_box.png"
out <- file.path(outdir, filename)
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, stats_ctrl_vs_mut = ctrl_vs_mut, data = d, file = out))
}
.plot_phase_box_mw <- function(dn,
outdir,
filename,
color_map = NULL,
genotype_labels = NULL,
phase_labels = c(Light="Day", Dark="Night"),
title = NULL,
x_label = NULL,
y_label = NULL,
show_legend = TRUE,
show_dots = TRUE,
dot_size = 0.8,
legend_text_size = 14,
legend_title_size = 0,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_brackets = TRUE,
drop_ns = TRUE,
width_in = 4, height_in = 4, dpi = 300) {
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
mode <- attr(dn, "mode")
if (is.null(x_label)) x_label <- if (!is.null(mode) && mode %in% c("DD","LL")) "CT phase" else NULL
# stable ordering
dn$phase <- factor(dn$phase, levels = names(phase_labels))
if (!is.null(color_map)) dn$genotype <- factor(dn$genotype, levels = names(color_map))
# ---- Mann–Whitney ctrl vs mutant ----
ctrl_vs_mut <- pairwise_vs_mutant_by_phase(
dn, value_col = "value",
mutant = mutant, controls = controls,
p_adjust = "BH"
) |>
dplyr::mutate(
p_use = dplyr::coalesce(p_adj, p),
label = vapply(p_use, .p_to_stars, character(1))
)
if (drop_ns) ctrl_vs_mut <- ctrl_vs_mut |> dplyr::filter(!is.na(label), label != "ns")
# ---- plot ----
p <- ggplot2::ggplot(dn, ggplot2::aes(x = phase, y = value, fill = genotype)) +
ggplot2::geom_boxplot(
position = ggplot2::position_dodge(width = 0.6),
width = 0.6, alpha = 0.9, outlier.shape = NA
) +
ggplot2::labs(x = x_label, y = y_label, title = title) +
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
legend.text = ggplot2::element_text(size = legend_text_size),
legend.title = ggplot2::element_text(size = legend_title_size),
plot.title = ggplot2::element_text(hjust = 0.5, size = 26),
axis.title.y = ggplot2::element_text(size = 20),
axis.text = ggplot2::element_text(size = 14),
plot.margin = ggplot2::margin(t = 12, r = 10, b = 6, l = 6)
) +
ggplot2::scale_x_discrete(labels = phase_labels) +
ggplot2::scale_y_continuous(limits = c(0, NA),
expand = ggplot2::expansion(mult = c(0, 0.18))) +
ggplot2::coord_cartesian(clip = "off")
if (show_dots) {
p <- p + ggplot2::geom_point(
position = ggplot2::position_jitterdodge(jitter.width = 0.04, dodge.width = 0.6),
size = dot_size, alpha = 0.6, shape = 16, color = "black"
)
}
if (!is.null(color_map)) {
if (!is.null(genotype_labels)) {
genotype_labels <- genotype_labels[names(color_map)]
p <- p +
ggplot2::scale_fill_manual(
values = color_map, breaks = names(color_map),
labels = parse(text = genotype_labels)
) +
ggplot2::guides(fill = ggplot2::guide_legend(label = ggplot2::label_parsed))
} else {
p <- p + ggplot2::scale_fill_manual(values = color_map, breaks = names(color_map))
}
}
if (show_brackets && nrow(ctrl_vs_mut)) {
genotype_order <- if (!is.null(color_map)) names(color_map) else levels(dn$genotype)
p <- .add_pairwise_brackets_from_build(
p,
stats_df = ctrl_vs_mut,
genotype_order = genotype_order,
y_pad_frac = 0.06,
text_size = 5
)
}
out <- file.path(outdir, filename)
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, stats_ctrl_vs_mut = ctrl_vs_mut, data = dn, file = out, mode = mode))
}
plot_daynight_bout_count_box <- function(df,
metric = c("sleep","activity"),
zt0_hour = 6L,
sleep_block_min = 5L,
activity_threshold = 0L,
summarize_days = c("mean","median"),
outdir = "DAM_Graphs",
filename = NULL,
color_map = NULL,
genotype_labels = NULL,
phase_labels = c(Light="Day", Dark="Night"),
title = NULL,
y_label = NULL,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = TRUE,
show_dots = TRUE,
dot_size = 0.8,
show_brackets = TRUE,
drop_ns = TRUE,
width_in = 4, height_in = 4, dpi = 300) {
metric <- match.arg(metric)
summarize_days <- match.arg(summarize_days)
dn <- build_daynight_bout_metric(
df, metric = metric, what = "count",
zt0_hour = zt0_hour,
sleep_block_min = sleep_block_min,
activity_threshold = activity_threshold,
summarize_days = summarize_days
)
if (is.null(title)) title <- sprintf("%s bouts (count)", if (metric == "sleep") "Sleep" else "Activity")
if (is.null(y_label)) y_label <- "Bouts per 12h"
if (is.null(filename)) filename <- sprintf("DAM_%s_boutcount_day_night_box.png", metric)
.plot_phase_box_mw(
dn,
outdir = outdir,
filename = filename,
color_map = color_map,
genotype_labels = genotype_labels,
phase_labels = phase_labels,
title = title,
y_label = y_label,
mutant = mutant,
controls = controls,
show_legend = show_legend,
show_dots = show_dots,
dot_size = dot_size,
show_brackets = show_brackets,
drop_ns = drop_ns,
width_in = width_in,
height_in = height_in,
dpi = dpi
)
}
plot_daynight_bout_duration_box <- function(df,
metric = c("sleep","activity"),
zt0_hour = 6L,
sleep_block_min = 5L,
activity_threshold = 0L,
summarize_days = c("mean","median"),
outdir = "DAM_Graphs",
filename = NULL,
color_map = NULL,
genotype_labels = NULL,
phase_labels = c(Light="Day", Dark="Night"),
title = NULL,
y_label = NULL,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = TRUE,
show_dots = TRUE,
dot_size = 0.8,
show_brackets = TRUE,
drop_ns = TRUE,
width_in = 4, height_in = 4, dpi = 300) {
metric <- match.arg(metric)
summarize_days <- match.arg(summarize_days)
dn <- build_daynight_bout_metric(
df, metric = metric, what = "duration",
zt0_hour = zt0_hour,
sleep_block_min = sleep_block_min,
activity_threshold = activity_threshold,
summarize_days = summarize_days
)
if (is.null(title)) title <- sprintf("%s bout duration", if (metric == "sleep") "Sleep" else "Activity")
if (is.null(y_label)) y_label <- "Mean bout duration (min)"
if (is.null(filename)) filename <- sprintf("DAM_%s_boutdur_day_night_box.png", metric)
.plot_phase_box_mw(
dn,
outdir = outdir,
filename = filename,
color_map = color_map,
genotype_labels = genotype_labels,
phase_labels = phase_labels,
title = title,
y_label = y_label,
mutant = mutant,
controls = controls,
show_legend = show_legend,
show_dots = show_dots,
dot_size = dot_size,
show_brackets = show_brackets,
drop_ns = drop_ns,
width_in = width_in,
height_in = height_in,
dpi = dpi
)
}
####period functions####
# Detrend helper (optional)
.detrend <- function(y, method = c("none","linear","loess")) {
method <- match.arg(method)
y <- as.numeric(y)
if (method == "none") return(y)
t <- seq_along(y)
if (method == "linear") {
fit <- stats::lm(y ~ t)
return(y - stats::predict(fit))
} else { # loess
# lite loess with large span to capture slow drift
fit <- try(stats::loess(y ~ t, span = 0.3, family = "symmetric"), silent = TRUE)
if (inherits(fit, "try-error")) return(y)
y - stats::predict(fit)
}
}
# Bin to k-minute means (handles NAs)
.bin_series <- function(ts, val, by_min = 5L) {
stopifnot(length(ts) == length(val))
if (by_min <= 1L) return(data.frame(ts = ts, val = val, bin_min = 1L))
# Bin start at first minute boundary
origin <- min(ts, na.rm = TRUE)
bin <- as.integer(difftime(ts, origin, units = "mins")) %/% as.integer(by_min)
agg <- stats::aggregate(val ~ bin, FUN = function(z) mean(z, na.rm = TRUE))
agg_ts <- origin + (agg$bin * by_min) * 60
data.frame(ts = agg_ts, val = agg$val, bin_min = as.integer(by_min))
}
# Core estimator: ACF or Lomb
.est_period <- function(y, samp_min = 1L, min_h = 18, max_h = 30, method = c("acf","lomb")) {
method <- match.arg(method)
y <- as.numeric(y); y[is.na(y)] <- 0
if (all(y == 0)) return(c(period_h = NA_real_, strength = NA_real_))
if (method == "acf") {
a <- stats::acf(y, plot = FALSE, lag.max = 72*60/samp_min)
# acf$lags are fractions of series length; convert to minutes correctly
n <- length(y)
lags_idx <- seq_along(a$acf[,1,1]) - 1L
lags_min <- lags_idx * samp_min
lags_h <- lags_min / 60
ok <- which(lags_h >= min_h & lags_h <= max_h)
if (!length(ok)) return(c(period_h = NA_real_, strength = NA_real_))
# Avoid trivially-large low-frequency trend: use first local max in window
idx <- ok[which.max(a$acf[ok,1,1])]
c(period_h = lags_h[idx], strength = a$acf[idx,1,1])
} else {
if (!requireNamespace("lomb", quietly = TRUE)) return(c(period_h = NA_real_, strength = NA_real_))
t <- seq_along(y) * samp_min # minutes
ls <- lomb::lsp(data.frame(t = t, y = y),
from = 1/(max_h*60), to = 1/(min_h*60),
ofac = 4, type = "period", plot = FALSE)
pk <- which.max(ls$power)
c(period_h = ls$scanned[pk]/60, strength = ls$power[pk])
}
}
# Public API
analyze_periodicity <- function(df,
method = c("acf","lomb"),
min_period_h = 18, max_period_h = 30,
bin_minutes = 5L,
detrend = c("none","linear","loess")) {
method <- match.arg(method)
detrend <- match.arg(detrend)
# Build per-tube, regularly sampled series (we already have per-minute rows)
# Optionally bin to reduce noise
out <- df %>%
dplyr::arrange(ts) %>%
dplyr::group_by(genotype, tube) %>%
dplyr::summarise({
s <- .bin_series(ts, count_na0, by_min = as.integer(bin_minutes))
y <- .detrend(s$val, method = detrend)
est <- .est_period(y,
samp_min = as.integer(bin_minutes),
min_h = min_period_h, max_h = max_period_h,
method = method)
dplyr::tibble(
bin_minutes = as.integer(bin_minutes),
detrend = detrend,
method = method,
n_minutes = sum(!is.na(s$val)) * as.integer(bin_minutes),
frac_nonzero= mean(s$val > 0, na.rm = TRUE),
period_h = as.numeric(est[[1]]),
strength = as.numeric(est[[2]])
)
}, .groups = "drop")
out
}
plot_period_distribution <- function(per_tbl,
outdir = outdamdir,
color_map = NULL,
genotype_labels = NULL, # named plotmath strings
show_legend = TRUE,
trim = FALSE, # <- default FALSE per your request
width_in = 6, height_in = 4, dpi = 300,
filename = NULL) {
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
# keep finite only for plotting
per_tbl <- per_tbl |>
dplyr::filter(is.finite(period_h))
# stable ordering if color_map supplied
if (!is.null(color_map)) {
per_tbl <- per_tbl |>
dplyr::mutate(genotype = factor(genotype, levels = names(color_map)))
}
# pretty x-axis labels (plotmath), independent of legend
x_scale <- ggplot2::scale_x_discrete()
if (!is.null(genotype_labels)) {
if (!is.null(color_map)) genotype_labels <- genotype_labels[names(color_map)]
x_scale <- ggplot2::scale_x_discrete(
breaks = names(genotype_labels),
labels = parse(text = genotype_labels)
)
}
# natural y-range like the original: min/max with a bit of padding
y_min <- suppressWarnings(min(per_tbl$period_h, na.rm = TRUE))
y_max <- suppressWarnings(max(per_tbl$period_h, na.rm = TRUE))
if (!is.finite(y_min) || !is.finite(y_max)) {
y_min <- 18; y_max <- 30
}
yr <- y_max - y_min
if (!is.finite(yr) || yr <= 0) yr <- 1
y_pad <- 0.08 * yr
p <- ggplot2::ggplot(per_tbl, ggplot2::aes(x = genotype, y = period_h, fill = genotype)) +
ggplot2::geom_violin(trim = trim, alpha = 0.3) +
ggplot2::geom_boxplot(width = 0.2, outlier.shape = NA, alpha = 0.9) +
ggplot2::geom_jitter(ggplot2::aes(color = genotype),
width = 0.1, alpha = 0.5, size = 1,
show.legend = FALSE) +
ggplot2::geom_hline(yintercept = 24, linetype = 2, linewidth = 0.8, alpha = 0.7) +
ggplot2::labs(x = NULL, y = "Estimated period (h)", title = "Circadian Period") +
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
plot.title = ggplot2::element_text(hjust = 0.5)
) +
x_scale +
ggplot2::coord_cartesian(ylim = c(y_min - y_pad, y_max + y_pad), clip = "off")
if (!is.null(color_map)) {
p <- p +
ggplot2::scale_fill_manual(values = color_map, breaks = names(color_map)) +
ggplot2::scale_color_manual(values = color_map, breaks = names(color_map))
}
if (is.null(filename)) {
filename <- sprintf("DAM_period_distribution_%s.png", format(Sys.time(), "%Y%m%d_%H%M%S"))
}
out <- file.path(outdir, filename)
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, file = out))
}
plot_periodogram <- function(df, genotype, tube,
method = c("acf","lomb"),
bin_minutes = 5L,
detrend = c("none","linear","loess"),
min_period_h = 18, max_period_h = 30,
outdir = outdamdir, width_in = 4, height_in = 4, dpi = 300) {
method <- match.arg(method)
detrend <- match.arg(detrend)
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
dd <- df %>% dplyr::filter(genotype == !!genotype, tube == !!tube) %>% dplyr::arrange(ts)
stopifnot(nrow(dd) > 0)
s <- .bin_series(dd$ts, dd$count_na0, by_min = as.integer(bin_minutes))
y <- .detrend(s$val, method = detrend); y[is.na(y)] <- 0
if (method == "acf") {
a <- stats::acf(y, plot = FALSE, lag.max = 72*60/as.integer(bin_minutes))
lags_idx <- seq_along(a$acf[,1,1]) - 1L
lags_h <- (lags_idx * as.integer(bin_minutes))/60
d <- data.frame(period_h = lags_h, strength = a$acf[,1,1])
d <- d[d$period_h >= min_period_h & d$period_h <= max_period_h, ]
p <- ggplot2::ggplot(d, ggplot2::aes(x = period_h, y = strength)) +
ggplot2::geom_line(linewidth = 0.8) +
ggplot2::labs(x = "Lag (h)", y = "ACF", title = sprintf("ACF periodogram — %s tube %d", genotype, tube)) +
ggplot2::theme_classic(base_size = 12)
} else {
if (!requireNamespace("lomb", quietly = TRUE)) stop("Package 'lomb' not installed.")
t <- seq_along(y) * as.integer(bin_minutes)
ls <- lomb::lsp(data.frame(t = t, y = y),
from = 1/(max_period_h*60), to = 1/(min_period_h*60),
ofac = 4, type = "period", plot = FALSE)
d <- data.frame(period_h = ls$scanned/60, power = ls$power)
p <- ggplot2::ggplot(d, ggplot2::aes(x = period_h, y = power)) +
ggplot2::geom_line(linewidth = 0.8) +
ggplot2::labs(x = "Period (h)", y = "Lomb power", title = sprintf("Lomb–Scargle — %s tube %d", genotype, tube)) +
ggplot2::theme_classic(base_size = 12)
}
out <- file.path(outdir, sprintf("DAM_periodogram_%s_tube%02d_%s.png",
genotype, as.integer(tube), format(Sys.time(), "%Y%m%d_%H%M%S")))
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, file = out))
}
# Estimate per-tube periods with ACF, binned to 5 min, loess detrend
plot_period_box <- function(per_tbl,
outdir = "DAM_Graphs",
filename = "DAM_period_box.png",
color_map = NULL,
genotype_labels = NULL,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = TRUE,
show_dots = TRUE,
dot_size = 0.9,
drop_ns = TRUE,
y_label = "Estimated period (h)",
title = "Circadian period",
width_in = 4.5, height_in = 4, dpi = 300) {
dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
d <- per_tbl |>
dplyr::filter(is.finite(period_h)) |>
dplyr::transmute(genotype, tube, value = period_h)
# stable ordering
if (!is.null(color_map)) d$genotype <- factor(d$genotype, levels = names(color_map))
# ---- Mann–Whitney control vs mutant ----
d_phase <- d |>
dplyr::mutate(phase = "All")
# ---- Mann–Whitney ctrl vs mutant (same helper you already trust) ----
ctrl_vs_mut <- pairwise_vs_mutant_by_phase(
d_phase,
value_col = "value",
mutant = mutant,
controls = controls,
p_adjust = "BH"
) |>
dplyr::mutate(
p_use = dplyr::coalesce(p_adj, p),
label = vapply(p_use, .p_to_stars, character(1))
)
if (drop_ns) {
ctrl_vs_mut <- ctrl_vs_mut |> dplyr::filter(!is.na(label), label != "ns")
}
# ---- plot ----
# --- y padding so boxes aren't micro / clipped ---
y_min <- min(d$value, na.rm = TRUE)
y_max <- max(d$value, na.rm = TRUE)
yr <- y_max - y_min
if (!is.finite(yr) || yr <= 0) yr <- 0.1
y_pad <- 0.12 * yr
p <- ggplot2::ggplot(d, ggplot2::aes(x = genotype, y = value, fill = genotype)) +
# draw the 24h reference line FIRST so it doesn't cover boxes
ggplot2::geom_hline(yintercept = 24, linetype = 2, linewidth = 0.6, alpha = 0.5) +
# make box outlines visible
ggplot2::geom_boxplot(
width = 0.55,
outlier.shape = NA,
alpha = 0.6,
color = "black",
linewidth = 0.6
) +
ggplot2::labs(x = NULL, y = y_label, title = title) +
ggplot2::theme_classic(base_size = 12) +
ggplot2::theme(
legend.position = if (show_legend) "right" else "none",
plot.title = ggplot2::element_text(hjust = 0.5, size = 26),
axis.title.y = ggplot2::element_text(size = 20),
axis.text = ggplot2::element_text(size = 14),
axis.text.x = ggplot2::element_text(angle = 45, hjust = 1, vjust = 1), # <- NEW
plot.margin = ggplot2::margin(t = 12, r = 10, b = 6, l = 6)
) +
ggplot2::scale_y_continuous(expand = ggplot2::expansion(mult = c(0.02, 0.10))) +
ggplot2::coord_cartesian(ylim = c(y_min - y_pad, y_max + y_pad), clip = "off")
if (show_dots) {
p <- p + ggplot2::geom_point(
position = ggplot2::position_jitter(width = 0.10),
size = dot_size, alpha = 0.6, shape = 16, color = "black",
show.legend = FALSE
)
}
# colors + parsed genotype labels (legend + x-axis)
if (!is.null(color_map)) {
if (!is.null(genotype_labels)) {
genotype_labels <- genotype_labels[names(color_map)]
p <- p +
ggplot2::scale_fill_manual(values = color_map,
breaks = names(color_map),
labels = parse(text = genotype_labels)) +
ggplot2::scale_x_discrete(breaks = names(color_map),
labels = parse(text = genotype_labels)) +
ggplot2::guides(fill = ggplot2::guide_legend(label = ggplot2::label_parsed))
} else {
p <- p + ggplot2::scale_fill_manual(values = color_map, breaks = names(color_map))
}
} else if (!is.null(genotype_labels)) {
p <- p + ggplot2::scale_x_discrete(breaks = names(genotype_labels),
labels = parse(text = genotype_labels))
}
# brackets (same style helper you already use)
if (nrow(ctrl_vs_mut)) {
genotype_order <- if (!is.null(color_map)) names(color_map) else levels(factor(d$genotype))
p <- .add_pairwise_brackets_from_build(
p,
stats_df = ctrl_vs_mut,
genotype_order = genotype_order,
y_pad_frac = 0.06,
text_size = 5
)
}
out <- file.path(outdir, filename)
ggplot2::ggsave(out, p, width = width_in, height = height_in, dpi = dpi)
invisible(list(plot = p, stats_ctrl_vs_mut = ctrl_vs_mut, data = d, file = out))
}
###GMR77A03 LD####
#### read file, purge dead flies####
setwd("/Users/jvaughen/Dropbox/Anurag_MS/sleep/")
outdamdir<-"/Users/jvaughen/Dropbox/Anurag_MS/sleep/GMR77A03/Graphs/"
damcolors <- c(
pex5 = "#1B7837",
CG_GAL4 = "#2166AC",
CG_GAL4_pex5 = "magenta3"
)
genotype_labels <- c(
pex5 = "italic(Pex5^{KD})",
CG_GAL4 = "italic(CG *'>')", # or whatever you want this called
CG_GAL4_pex5 = "italic(CG *'>'*Pex5^{KD})"
)
#printing legend
df_leg <- data.frame(
x = 1:3,
y = 1,
genotype = factor(names(damcolors), levels = names(damcolors))
)
p_leg <- ggplot(df_leg, aes(x, y, fill = genotype)) +
geom_col(width = 0.6) +
scale_fill_manual(
values = damcolors,
breaks = names(damcolors),
labels = parse(text = genotype_labels[names(damcolors)])
) +
guides(
fill = guide_legend(
title = NULL,
label = label_parsed
)
) +
theme_void() +
theme(
legend.position = "right",
legend.text = element_text(size = 14),
legend.title = element_blank()
)
# Extract legend
leg <- cowplot::get_legend(p_leg)
# Save with WHITE background
png(
filename = "GMR77A03/DAM_legend.png",
width = 700,
height = 300,
res = 300,
bg = "white" # <-- this is the key line
)
grid.newpage()
grid.draw(leg)
dev.off()
specs <- list(
# Oct run
list(path="GMR77A03/Oct1-5.txt", run_id="Oct1-5", date_start="2025-10-01", date_end="2025-10-05",
genotype="CG_GAL4_pex5", tubes=1:10),
list(path="GMR77A03/Oct1-5.txt", run_id="Oct1-5", date_start="2025-10-01", date_end="2025-10-05",
genotype="pex5", tubes=11:21),
list(path="GMR77A03/Oct1-5.txt", run_id="Oct1-5", date_start="2025-10-01", date_end="2025-10-05",
genotype="CG_GAL4", tubes=22:32),
# Nov run 1
list(path="GMR77A03/Nov8-12.txt", run_id="Nov8-12", date_start="2025-11-08", date_end="2025-11-12",
genotype="CG_GAL4_pex5", tubes=1:10),
list(path="GMR77A03/Nov8-12.txt", run_id="Nov8-12", date_start="2025-11-08", date_end="2025-11-12",
genotype="pex5", tubes=11:21),
list(path="GMR77A03/Nov8-12.txt", run_id="Nov8-12", date_start="2025-11-08", date_end="2025-11-12",
genotype="CG_GAL4", tubes=22:32),
# Nov run 2
list(path="GMR77A03/Nov14-19.txt", run_id="Nov14-19", date_start="2025-11-14", date_end="2025-11-19",
genotype="CG_GAL4_pex5", tubes=1:10),
list(path="GMR77A03/Nov14-19.txt", run_id="Nov14-19", date_start="2025-11-14", date_end="2025-11-19",
genotype="pex5", tubes=11:21),
list(path="GMR77A03/Nov14-19.txt", run_id="Nov14-19", date_start="2025-11-14", date_end="2025-11-19",
genotype="CG_GAL4", tubes=22:32),
# Jan run
list(path="GMR77A03/23jan_26janLD_28jan-2_DD.txt", run_id="Jan23-26", date_start="2025-01-23", date_end="2025-01-26",
genotype="CG_GAL4_pex5", tubes=1:10),
list(path="GMR77A03/23jan_26janLD_28jan-2_DD.txt", run_id="Jan23-26", date_start="2025-01-23", date_end="2025-01-26",
genotype="pex5", tubes=11:21),
list(path="GMR77A03/23jan_26janLD_28jan-2_DD.txt", run_id="Jan23-26", date_start="2025-01-23", date_end="2025-01-26",
genotype="CG_GAL4", tubes=22:32)
)
df <- read_dam_specs(specs, fill_missing=TRUE)
lc <- infer_light_cycle(df) # prints median lights-on/off
df2 <- df %>%
dplyr::group_by(run_id) %>%
dplyr::group_modify(\(d, key) remove_dead(d, inactivity_hours = 12, quiet = F)$data) %>%
dplyr::ungroup()
#make sure ok, tallying n
df2 %>%
dplyr::distinct(run_id, genotype, tube) %>%
dplyr::count(run_id, genotype, name = "n_tubes") %>%
tidyr::pivot_wider(names_from = genotype, values_from = n_tubes, values_fill = 0)
df2 %>%
dplyr::distinct(run_id, genotype, tube) %>%
dplyr::count(genotype, name = "n_total_tubes") %>%
dplyr::arrange(desc(n_total_tubes))
df2 %>%
dplyr::distinct(run_id, genotype, tube) %>%
dplyr::count(genotype, name = "n_flies_total")
# How many unique tube numbers (pooled across runs) are being used?
df2 %>%
dplyr::distinct(genotype, tube) %>%
dplyr::count(genotype, name = "n_tube_numbers")
#dead <- remove_dead(df, inactivity_hours = 12)
#View(dead$purged) # which tubes were removed. highest = dead whole time, lowest is based on threshodl. dont think mintues are acutally being treated properly
####zt average plots####
plot_average_day(
df2, metric = "activity", bin_minutes = 5,
color_map = damcolors,
genotype_labels = genotype_labels,
mean_linewidth = 0.8, sem_alpha = 0.25,
title = "Average Activity", y_label = "Counts / min", x_label = "ZT",
title_size = 26, axis_title_size = 20, axis_text_size = 14,
show_bg_phase_shading = F,
bg_light_color = "#FFF7AE", bg_light_alpha = 0.22,
bg_dark_color = "#1E2430", bg_dark_alpha = 0.22,
show_phase_bar = T, phase_bar_position = "below", bar_height_frac = 0.04,
bar_light_color = "#FFF7AE", bar_dark_color = "#22313F", show_legend = F,
outdir = outdamdir, filename = "avgday_activity1.png",
width_in = 5, height_in = 4
)
# Sleep: turn off phase bar, keep background shading
plot_average_day(
df2, metric = "sleep", bin_minutes = 5,
genotype_labels = genotype_labels,
color_map = damcolors,
mean_linewidth = 0.8, sem_alpha = 0.25,
title = "Average Sleep", y_label = "Sleep probability/ min", x_label = "ZT",
title_size = 26, axis_title_size = 20, axis_text_size = 14,show_legend = F,
show_bg_phase_shading = F,
bg_light_color = "#FFF7AE", bg_light_alpha = 0.22,
bg_dark_color = "#1E2430", bg_dark_alpha = 0.22,
show_phase_bar = T, bar_height_frac = 0.04, phase_bar_position="below",
bar_light_color = "#FFF7AE", bar_dark_color = "#22313F",
outdir = outdamdir, filename = "avgday_sleep1.png",
width_in = 5, height_in = 4
)
####boxplots+stats####
res_act <- plot_daynight_activity_box(
df2,
outdir = outdamdir,
color_map = damcolors,
genotype_labels = genotype_labels,
show_kw_stars = FALSE,
show_brackets = TRUE,
show_legend =F,
drop_ns = TRUE,
width_in = 4,
dot_size = 1,
height_in = 4
)
# Sleep boxplots + stats
res_slp <- plot_daynight_sleep_box(
df2,
sleep_block_min = 5,
outdir = outdamdir,
color_map = damcolors,
genotype_labels = genotype_labels,
title = "Sleep",
y_label = "Sleep (Minutes per day)",
show_legend = F,
show_dots = TRUE,
dot_size = 1,
width_in = 4, height_in = 4, dpi = 300
)
####period####
per <- analyze_periodicity(df2, method = "acf", bin_minutes = 5, detrend = "loess")
plot_period_box(per, outdir = outdamdir, color_map = damcolors, genotype_labels = genotype_labels,
mutant= "CG_GAL4_pex5", controls = c("pex5","CG_GAL4"), show_legend=F, width_in = 4, height_in = 4)
####bouts 77a03 ld####
res_sleep_bouts_n <- plot_daynight_bout_count_box(
df2,
metric = "sleep",
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_bout_count.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_sleep_boutdur <- plot_daynight_bout_duration_box(
df2,
metric = "sleep",
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_bout_duration.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_act_bouts_n <- plot_daynight_bout_count_box(
df2,
metric = "activity",
activity_threshold = 0L, # active minute = count>0
zt0_hour = 6L,
outdir = outdamdir,
filename = "activity_bout_count.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_latency <- plot_sleep_latency_box(
df2,
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_latency.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
#### Export metrics — GMR77A03 LD ####
export_metrics_xlsx(
outdamdir = outdamdir,
res_act = res_act,
res_slp = res_slp,
res_sleep_bouts_n = res_sleep_bouts_n,
res_sleep_boutdur = res_sleep_boutdur,
res_act_bouts_n = res_act_bouts_n,
res_latency = res_latency,
per = per,
filename = "S1_Data.xlsx"
)
###GMR77A03 DD####
#### read file, purge dead flies####
#setwd("/Users/jvaughen/Dropbox/sapr/data/Dam/")
setwd("/Users/jvaughen/Dropbox/Anurag_MS/sleep/")
outdamdir<-"/Users/jvaughen/Dropbox/Anurag_MS/sleep/GMR77A03/DD/Graphs/"
#this caused r nearly to crash- need to find smarter way to trim brefore combining 32 tubes across that many timepoints (and we oversampled..)
#damcolors<-c(gba1b= "#AA4499", control = "#44AA99")
damcolors <- c(
pex5 = "#1B7837",
CG_GAL4 = "#2166AC",
CG_GAL4_pex5 = "magenta3"
)
genotype_labels <- c(
pex5 = "italic(Pex5^{KD})",
CG_GAL4 = "italic(CG *'>')", # or whatever you want this called
CG_GAL4_pex5 = "italic(CG *'>'*Pex5^{KD})"
)
#printing legend
df_leg <- data.frame(
x = 1:3,
y = 1,
genotype = factor(names(damcolors), levels = names(damcolors))
)
p_leg <- ggplot(df_leg, aes(x, y, fill = genotype)) +
geom_col(width = 0.6) +
scale_fill_manual(
values = damcolors,
breaks = names(damcolors),
labels = parse(text = genotype_labels[names(damcolors)])
) +
guides(
fill = guide_legend(
title = NULL,
label = label_parsed
)
) +
theme_void() +
theme(
legend.position = "right",
legend.text = element_text(size = 14),
legend.title = element_blank()
)
# Extract legend
leg <- cowplot::get_legend(p_leg)
# Save with WHITE background
png(
filename = "GMR77A03/DD/DAM_legend.png",
width = 700,
height = 300,
res = 300,
bg = "white" # <-- this is the key line
)
grid.newpage()
grid.draw(leg)
dev.off()
specs <- list(
list(path="GMR77A03/23jan_26janLD_28jan-2_DD.txt", run_id="Jan28-2", date_start="2025-01-28", date_end="2025-02-2",
genotype="CG_GAL4_pex5", tubes=1:10),
list(path="GMR77A03/23jan_26janLD_28jan-2_DD.txt",run_id="Jan28-2", date_start="2025-01-28", date_end="2025-02-2",
genotype="pex5", tubes=11:21),
list(path="GMR77A03/23jan_26janLD_28jan-2_DD.txt", run_id="Jan28-2", date_start="2025-01-28", date_end="2025-02-2",
genotype="CG_GAL4", tubes=22:32)
)
df <- read_dam_specs(specs, fill_missing=TRUE)
lc <- infer_light_cycle(df, zt0_hour = 6L) # prints median lights-on/off
df2 <- df %>%
dplyr::group_by(run_id) %>%
dplyr::group_modify(\(d, key) remove_dead(d, inactivity_hours = 12, quiet = F)$data) %>%
dplyr::ungroup()
####zt average plots####
plot_average_day(
df2, metric = "activity", bin_minutes = 5,
color_map = damcolors,
genotype_labels = genotype_labels,
mean_linewidth = 0.8, sem_alpha = 0.25,
title = "Average Activity", y_label = "Counts / min", x_label = "CT",
title_size = 26, axis_title_size = 20, axis_text_size = 14,
show_bg_phase_shading = F,
bg_light_color = "#FFF7AE", bg_light_alpha = 0.22,
bg_dark_color = "#1E2430", bg_dark_alpha = 0.22,
show_phase_bar = T, phase_bar_position = "below", bar_height_frac = 0.04,
bar_light_color = "#22313F", bar_dark_color = "#22313F", show_legend = F,
outdir = outdamdir, filename = "avgday_activity1.png",
width_in = 5, height_in = 4
)
# Sleep: turn off phase bar, keep background shading
plot_average_day(
df2, metric = "sleep", bin_minutes = 5,
genotype_labels = genotype_labels,
color_map = damcolors,
mean_linewidth = 0.8, sem_alpha = 0.25,
title = "Average Sleep", y_label = "Sleep probability/ min", x_label = "CT",
title_size = 26, axis_title_size = 20, axis_text_size = 14,show_legend = F,
show_bg_phase_shading = F,
bg_light_color = "#FFF7AE", bg_light_alpha = 0.22,
bg_dark_color = "#1E2430", bg_dark_alpha = 0.22,
show_phase_bar = T, bar_height_frac = 0.04, phase_bar_position="below",
bar_light_color = "#22313F", bar_dark_color = "#22313F",
outdir = outdamdir, filename = "avgday_sleep1.png",
width_in = 5, height_in = 4
)
####boxplots+stats####
res_act <- plot_daynight_metric_box(
df2,
metric = "activity",
zt0_hour = 6L,
outdir = outdamdir,
color_map = damcolors,
genotype_labels = genotype_labels,
show_kw_stars = FALSE,
show_brackets = TRUE,
show_legend =F,
drop_ns = TRUE,
width_in = 4,
dot_size = 1,
height_in = 4
)
# Sleep boxplots + stats
res_slp <- plot_daynight_metric_box(
df2,
zt0_hour = 6L,
metric = "sleep",
sleep_block_min = 5,
outdir = outdamdir,
color_map = damcolors,
genotype_labels = genotype_labels,
title = "Sleep",
y_label = "Sleep (Minutes per day)",
show_legend = F,
show_dots = TRUE,
dot_size = 1,
width_in = 4, height_in = 4, dpi = 300
)
####period####
per <- analyze_periodicity(df2, method = "acf", bin_minutes = 5, detrend = "loess")
plot_period_box(per, outdir = outdamdir, color_map = damcolors, genotype_labels = genotype_labels,
mutant= "CG_GAL4_pex5", controls = c("pex5","CG_GAL4"), show_legend=F, width_in = 4, height_in = 4)
#
####bouts 77a03 dd####
res_sleep_bouts_n <- plot_daynight_bout_count_box(
df2,
metric = "sleep",
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_bout_count.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_sleep_boutdur <- plot_daynight_bout_duration_box(
df2,
metric = "sleep",
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_bout_duration.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_act_bouts_n <- plot_daynight_bout_count_box(
df2,
metric = "activity",
activity_threshold = 0L, # active minute = count>0
zt0_hour = 6L,
outdir = outdamdir,
filename = "activity_bout_count.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_latency <- plot_sleep_latency_box(
df2,
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_latency.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "CG_GAL4_pex5",
controls = c("pex5","CG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
#### Export metrics — GMR77A03 DD ####
export_metrics_xlsx(
outdamdir = outdamdir,
res_act = res_act,
res_slp = res_slp,
res_sleep_bouts_n = res_sleep_bouts_n,
res_sleep_boutdur = res_sleep_boutdur,
res_act_bouts_n = res_act_bouts_n,
res_latency = res_latency,
per = per,
filename = "S1_Data.xlsx"
)
####GMR57C10 nsyb####
#### read file, purge dead flies####
setwd("/Users/jvaughen/Dropbox/Anurag_MS/sleep/")
outdamdir<-"/Users/jvaughen/Dropbox/Anurag_MS/sleep/GMR57C10/Graphs/"
#this caused r nearly to crash- need to find smarter way to trim brefore combining 32 tubes across that many timepoints (and we oversampled..)
#damcolors<-c(gba1b= "#AA4499", control = "#44AA99")
damcolors <- c(
pex5 = "#1B7837",
nSyb_GAL4 = "#2166AC",
nSyb_GAL4_pex5 = "magenta3"
)
genotype_labels <- c(
pex5 = "italic(Pex5^{KD})",
nSyb_GAL4 = "italic(nSyb *'>')", # or whatever you want this called
nSyb_GAL4_pex5 = "italic(nSyb *'>'*Pex5^{KD})"
)
#printing legend
df_leg <- data.frame(
x = 1:3,
y = 1,
genotype = factor(names(damcolors), levels = names(damcolors))
)
p_leg <- ggplot(df_leg, aes(x, y, fill = genotype)) +
geom_col(width = 0.6) +
scale_fill_manual(
values = damcolors,
breaks = names(damcolors),
labels = parse(text = genotype_labels[names(damcolors)])
) +
guides(
fill = guide_legend(
title = NULL,
label = label_parsed
)
) +
theme_void() +
theme(
legend.position = "right",
legend.text = element_text(size = 14),
legend.title = element_blank()
)
# Extract legend
leg <- cowplot::get_legend(p_leg)
# Save with WHITE background
png(
filename = "GMR57C10/DAM_legend.png",
width = 700,
height = 300,
res = 300,
bg = "white" # <-- this is the key line
)
grid.newpage()
grid.draw(leg)
dev.off()
specs <- list(
list(path="GMR57C10/April16-20.txt", run_id="April16-20", date_start="2025-04-16", date_end="2025-04-20",
genotype="nSyb_GAL4_pex5", tubes=1:10),
list(path="GMR57C10/April16-20.txt", run_id="April16-20", date_start="2025-04-16", date_end="2025-04-20",
genotype="pex5", tubes=11:21),
list(path="GMR57C10/April16-20.txt", run_id="April16-20", date_start="2025-04-16", date_end="2025-04-20",
genotype="nSyb_GAL4", tubes=22:32)
)
df <- read_dam_specs(specs, fill_missing=TRUE)
lc <- infer_light_cycle(df) # prints median lights-on/off
df2 <- df %>%
dplyr::group_by(run_id) %>%
dplyr::group_modify(\(d, key) remove_dead(d, inactivity_hours = 12, quiet = F)$data) %>%
dplyr::ungroup()
outdamdir<-"/Users/jvaughen/Dropbox/Anurag_MS/sleep/GMR57C10/Graphs/"
####zt average plots####
plot_average_day(
df2, metric = "activity", bin_minutes = 5,
color_map = damcolors,
genotype_labels = genotype_labels,
mean_linewidth = 0.8, sem_alpha = 0.25,
title = "Average Activity", y_label = "Counts / min", x_label = "ZT",
title_size = 26, axis_title_size = 20, axis_text_size = 14,
show_bg_phase_shading = F,
bg_light_color = "#FFF7AE", bg_light_alpha = 0.22,
bg_dark_color = "#1E2430", bg_dark_alpha = 0.22,
show_phase_bar = T, phase_bar_position = "below", bar_height_frac = 0.04,
bar_light_color = "#FFF7AE", bar_dark_color = "#22313F", show_legend = F,
outdir = outdamdir, filename = "avgday_activity1.png",
width_in = 5, height_in = 4
)
# Sleep: turn off phase bar, keep background shading
plot_average_day(
df2, metric = "sleep", bin_minutes = 5,
genotype_labels = genotype_labels,
color_map = damcolors,
mean_linewidth = 0.8, sem_alpha = 0.25,
title = "Average Sleep", y_label = "Sleep probability/ min", x_label = "ZT",
title_size = 26, axis_title_size = 20, axis_text_size = 14,show_legend = F,
show_bg_phase_shading = F,
bg_light_color = "#FFF7AE", bg_light_alpha = 0.22,
bg_dark_color = "#1E2430", bg_dark_alpha = 0.22,
show_phase_bar = T, bar_height_frac = 0.04, phase_bar_position="below",
bar_light_color = "#FFF7AE", bar_dark_color = "#22313F",
outdir = outdamdir, filename = "avgday_sleep1.png",
width_in = 5, height_in = 4
)
####boxplots+stats####
res_act <- plot_daynight_activity_box(
df2,
outdir = outdamdir,
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "nSyb_GAL4_pex5",
controls = c("pex5","nSyb_GAL4"),
show_kw_stars = FALSE,
show_brackets = TRUE,
show_legend =F,
drop_ns = TRUE,
width_in = 4,
dot_size = 1,
height_in = 4
)
# Sleep boxplots + stats
res_slp <- plot_daynight_sleep_box(
df2,
mutant = "nSyb_GAL4_pex5",
controls = c("pex5","nSyb_GAL4"),
sleep_block_min = 5,
outdir = outdamdir,
color_map = damcolors,
genotype_labels = genotype_labels,
title = "Sleep",
y_label = "Sleep (Minutes per day)",
show_legend = F,
show_dots = TRUE,
dot_size = 1,
width_in = 4, height_in = 4, dpi = 300
)
####period + bouts GMR57C10####
per <- analyze_periodicity(df2, method = "acf", bin_minutes = 5, detrend = "loess")
plot_period_box(per, outdir = outdamdir, color_map = damcolors, genotype_labels = genotype_labels,
mutant= "nSyb_GAL4_pex5", controls = c("pex5","nSyb_GAL4"), show_legend=F, width_in = 4, height_in = 4)
####bouts nsyb####
res_sleep_bouts_n <- plot_daynight_bout_count_box(
df2,
metric = "sleep",
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_bout_count.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "nSyb_GAL4_pex5",
controls = c("pex5","nSyb_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_sleep_boutdur <- plot_daynight_bout_duration_box(
df2,
metric = "sleep",
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_bout_duration.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "nSyb_GAL4_pex5",
controls = c("pex5","nSyb_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_act_bouts_n <- plot_daynight_bout_count_box(
df2,
metric = "activity",
activity_threshold = 0L, # active minute = count>0
zt0_hour = 6L,
outdir = outdamdir,
filename = "activity_bout_count.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "nSyb_GAL4_pex5",
controls = c("pex5","nSyb_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_latency <- plot_sleep_latency_box(
df2,
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_latency.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "nSyb_GAL4_pex5",
controls = c("pex5","nSyb_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
#### Export metrics — GMR57C10 (nSyb) ####
export_metrics_xlsx(
outdamdir = outdamdir,
res_act = res_act,
res_slp = res_slp,
res_sleep_bouts_n = res_sleep_bouts_n,
res_sleep_boutdur = res_sleep_boutdur,
res_act_bouts_n = res_act_bouts_n,
res_latency = res_latency,
per = per,
filename = "S1_Data.xlsx"
)
####GMR56F03 (EG-GAL4)####
#### read file, purge dead flies####
#setwd("/Users/jvaughen/Dropbox/sapr/data/Dam/")
setwd("/Users/jvaughen/Dropbox/Anurag_MS/sleep/")
outdamdir<-"/Users/jvaughen/Dropbox/Anurag_MS/sleep/GMR56F03/Graphs/"
#this caused r nearly to crash- need to find smarter way to trim brefore combining 32 tubes across that many timepoints (and we oversampled..)
#damcolors<-c(gba1b= "#AA4499", control = "#44AA99")
damcolors <- c(
pex5 = "#1B7837",
EG_GAL4 = "#2166AC",
EG_GAL4_pex5 = "magenta3"
)
genotype_labels <- c(
pex5 = "italic(Pex5^{KD})",
EG_GAL4 = "italic(EG *'>')", # or whatever you want this called
EG_GAL4_pex5 = "italic(EG *'>'*Pex5^{KD})"
)
#printing legend
df_leg <- data.frame(
x = 1:3,
y = 1,
genotype = factor(names(damcolors), levels = names(damcolors))
)
p_leg <- ggplot(df_leg, aes(x, y, fill = genotype)) +
geom_col(width = 0.6) +
scale_fill_manual(
values = damcolors,
breaks = names(damcolors),
labels = parse(text = genotype_labels[names(damcolors)])
) +
guides(
fill = guide_legend(
title = NULL,
label = label_parsed
)
) +
theme_void() +
theme(
legend.position = "right",
legend.text = element_text(size = 14),
legend.title = element_blank()
)
# Extract legend
leg <- cowplot::get_legend(p_leg)
# Save with WHITE background
png(
filename = "GMR56F03/DAM_legend.png",
width = 700,
height = 300,
res = 300,
bg = "white" # <-- this is the key line
)
grid.newpage()
grid.draw(leg)
dev.off()
specs <- list(
list(path="GMR56F03/May8-11.txt", run_id="May8-11", date_start="2025-05-08", date_end="2025-05-11",
genotype="EG_GAL4_pex5", tubes=1:10),
list(path="GMR56F03/May8-11.txt", run_id="May8-11", date_start="2025-05-08", date_end="2025-05-11",
genotype="pex5", tubes=11:21),
list(path="GMR56F03/May8-11.txt", run_id="May8-11", date_start="2025-05-08", date_end="2025-05-11",
genotype="EG_GAL4", tubes=22:32)
)
df <- read_dam_specs(specs, fill_missing=TRUE)
lc <- infer_light_cycle(df) # prints median lights-on/off
df2 <- df %>%
dplyr::group_by(run_id) %>%
dplyr::group_modify(\(d, key) remove_dead(d, inactivity_hours = 12, quiet = F)$data) %>%
dplyr::ungroup()
outdamdir<-"/Users/jvaughen/Dropbox/Anurag_MS/sleep/GMR56F03/Graphs/"
####zt average plots####
plot_average_day(
df2, metric = "activity", bin_minutes = 5,
color_map = damcolors,
genotype_labels = genotype_labels,
mean_linewidth = 0.8, sem_alpha = 0.25,
title = "Average Activity", y_label = "Counts / min", x_label = "ZT",
title_size = 26, axis_title_size = 20, axis_text_size = 14,
show_bg_phase_shading = F,
bg_light_color = "#FFF7AE", bg_light_alpha = 0.22,
bg_dark_color = "#1E2430", bg_dark_alpha = 0.22,
show_phase_bar = T, phase_bar_position = "below", bar_height_frac = 0.04,
bar_light_color = "#FFF7AE", bar_dark_color = "#22313F", show_legend = F,
outdir = outdamdir, filename = "avgday_activity1.png",
width_in = 5, height_in = 4
)
# Sleep: turn off phase bar, keep background shading
plot_average_day(
df2, metric = "sleep", bin_minutes = 5,
genotype_labels = genotype_labels,
color_map = damcolors,
mean_linewidth = 0.8, sem_alpha = 0.25,
title = "Average Sleep", y_label = "Sleep probability/ min", x_label = "ZT",
title_size = 26, axis_title_size = 20, axis_text_size = 14,show_legend = F,
show_bg_phase_shading = F,
bg_light_color = "#FFF7AE", bg_light_alpha = 0.22,
bg_dark_color = "#1E2430", bg_dark_alpha = 0.22,
show_phase_bar = T, bar_height_frac = 0.04, phase_bar_position="below",
bar_light_color = "#FFF7AE", bar_dark_color = "#22313F",
outdir = outdamdir, filename = "avgday_sleep1.png",
width_in = 5, height_in = 4
)
####boxplots+stats####
res_act <- plot_daynight_activity_box(
df2,
outdir = outdamdir,
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "EG_GAL4_pex5",
controls = c("pex5","EG_GAL4"),
show_kw_stars = FALSE,
show_brackets = TRUE,
show_legend =F,
drop_ns = TRUE,
width_in = 4,
dot_size = 1,
height_in = 4
)
# Sleep boxplots + stats
res_slp <- plot_daynight_sleep_box(
df2,
mutant = "EG_GAL4_pex5",
controls = c("pex5","EG_GAL4"),
sleep_block_min = 5,
outdir = outdamdir,
color_map = damcolors,
genotype_labels = genotype_labels,
title = "Sleep",
y_label = "Sleep (Minutes per day)",
show_legend = F,
show_dots = TRUE,
dot_size = 1,
width_in = 4, height_in = 4, dpi = 300
)
####circadian####
per <- analyze_periodicity(df2, method = "acf", bin_minutes = 5, detrend = "loess")
plot_period_box(per, outdir = outdamdir, color_map = damcolors, genotype_labels = genotype_labels,
mutant= "EG_GAL4_pex5", controls = c("pex5","EG_GAL4"), show_legend=F, width_in = 4, height_in = 4)
####bouts####
res_sleep_bouts_n <- plot_daynight_bout_count_box(
df2,
metric = "sleep",
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_bout_count.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "EG_GAL4_pex5",
controls = c("pex5","EG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_sleep_boutdur <- plot_daynight_bout_duration_box(
df2,
metric = "sleep",
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_bout_duration.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "EG_GAL4_pex5",
controls = c("pex5","EG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_act_bouts_n <- plot_daynight_bout_count_box(
df2,
metric = "activity",
activity_threshold = 0L, # active minute = count>0
zt0_hour = 6L,
outdir = outdamdir,
filename = "activity_bout_count.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "EG_GAL4_pex5",
controls = c("pex5","EG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
res_latency <- plot_sleep_latency_box(
df2,
zt0_hour = 6L,
sleep_block_min = 5L,
outdir = outdamdir,
filename = "sleep_latency.png",
color_map = damcolors,
genotype_labels = genotype_labels,
mutant = "EG_GAL4_pex5",
controls = c("pex5","EG_GAL4"),
show_legend = FALSE,
dot_size = 1,
width_in = 4, height_in = 4
)
#### Export metrics — GMR56F03 (EG-GAL4) ####
export_metrics_xlsx(
outdamdir = outdamdir,
res_act = res_act,
res_slp = res_slp,
res_sleep_bouts_n = res_sleep_bouts_n,
res_sleep_boutdur = res_sleep_boutdur,
res_act_bouts_n = res_act_bouts_n,
res_latency = res_latency,
per = per,
filename = "S1_Data.xlsx"
)

DAM_2026_Das_metrics.R at commit a60091d, no license · at the source

Overview

Authors: Anurag Das^1,2, Irma Magaly Rivas-Serna³, Ankur Kumar^1,4, Lakpa Sherpa^1,4, Kerui Huang¹, Hia Kalita⁵, Marlene Dorneich-Hayes^1,4, Ruiqi Liu^1,5, Vera C Mazurak³, John P Vaughen⁶, Hua Bai¹

ORCID iDs: Anurag Das, John P Vaughen, Hua Bai

Department of Genetics, Development, and Cell Biology, Iowa State University, Ames, Iowa, United States of America
Interdepartmental Neuroscience PhD Program, Iowa State University, Ames, Iowa, United States of America
Department of Agriculture, Food, and Nutritional Science, University of Alberta, Edmonton, Canada
Interdepartmental Genetics & Genomics PhD Program, Iowa State University, Ames, Iowa, United States of America
Interdepartmental MCDB PhD Program, Iowa State University, Ames, Iowa, United States of America
Department of Anatomy, University of California San Francisco, San Francisco, California, United States of America

Institutions: Iowa State University (United States); University of Alberta (Canada); University of California, San Francisco (United States)

Journal: PLoS biology, volume 24, issue 7, article e3003901

Dates: received 28 March 2026; accepted 29 June 2026; published online 15 July 2026

Type: Research article · Language: English

License: CC BY

Identifiers: DOI 10.1371/journal.pbio.3003901 · PMID 42455861 · PMCID PMC13387613 · OpenAlex W4411639224

Open access: gold, a free copy (OpenAlex)

Preprint: doi:10.1101/2025.06.23.661129

Status: code verified

Categories: drosophila (organism), cellular / molecular (subfield)

Methods: Statistics, Smoothing, state filtering, decompositions, Machine learning, Preprocessing, Evoked potentials, Connectivity, fMRI & imaging

MeSH: Circadian Rhythm*, Lipid Metabolism*, Neuroglia*, Peroxisomes*, Sleep*, Animals, Brain, Circadian Clocks, Drosophila melanogaster, Drosophila Proteins, Neurons, Peroxisome-Targeting Signal 1 Receptor, Protein Transport (* major topic)

Topic: Circadian rhythm and melatonin (Endocrine and Autonomic Systems, Neuroscience), according to OpenAlex

Funding: NIH HHS (OT2 OD030544, P40 OD018537); National Science Foundation (NSF CAREER 2046984); National Institute on Aging (R01AG075156); NIDDK NIH HHS (U2C DK119886, U2C DK119889); NIA NIH HHS (R01 AG075156); Sandler Foundation; Simons Foundation; Hevolution (HF- GRO-23-1199062-14); NHGRI NIH HHS (U41 HG000739)

Citations: not cited yet (Europe PMC); 108 references in the paper

Research resources: RRID:BDSC_24650, RRID:BDSC_35780, RRID:BDSC_36304, RRID:BDSC_36318, RRID:BDSC_39157, RRID:BDSC_39171, RRID:BDSC_39944, RRID:BDSC_40362, RRID:BDSC_40878, RRID:BDSC_4559, RRID:BDSC_45784, RRID:BDSC_5130, RRID:BDSC_51324, RRID:BDSC_55322, RRID:BDSC_58064, D. melanogaster: w1118 RRID:BDSC_5905, RRID:BDSC_64248, RRID:BDSC_67032, RRID:BDSC_7415, D. melanogaster: per[01] RRID:BDSC_80928, R Studio 2023.12.1 (4.3.1) RRID:SCR_000432

Abstract

Peroxisomes are critical organelles that detoxify cellular waste while also catabolizing and anabolizing lipids. How peroxisomes coordinate protein import and support metabolic functions across complex tissues and timescales remains poorly understood in vivo. Using the Drosophila brain, we discover a striking enrichment of peroxisomes in the neuronal soma and the cortex glia that enwrap them. Unexpectedly, import of peroxisomal proteins into cortex glia, but not neurons, oscillated across time and peaked in the early morning. Rhythmic peroxisomal import in cortex glia autonomously required the circadian clock and Peroxin 5 (Pex5; peroxisomal biogenesis factor 5 homolog), with import persistently elevated in clock mutants. Notably, reducing Pex5 in cortex glia, but not neurons, caused hyperactivity and reduced total sleep. Moreover, brain lipid metabolism was dramatically altered upon Pex5 knockdown, with glia impacting sphingolipids and triacylglycerols, and neurons impacting phospholipids. The cell-type specificity of these Pex5 phenotypes highlights unique roles for peroxisomal import in both sleep and lipid metabolism in the brain.

Reproduced under the paper's license (CC BY), from the paper cited above.

Repositories

Its files are read in the Code ↔ Paper reader above, with 1 match between paragraphs and lines of code.

Zenodo 20637355

License: CC-BY-4.0

State: the link answers, verified on 27 September 2026

Evidence: files inventoried

Size: 1 file

Software Heritage: not checked

Found in: “Data Availability”

Not found: README, license file, CITATION.cff, environment file, tests, continuous integration, documentation

Tools: cowplot (2 files), ggplot2 (2 files), tidyverse (2 files), broom (1 file), circlize (1 file), ComplexHeatmap (1 file), emmeans (1 file), ggpubr (1 file), patchwork (1 file), rstatix (1 file)

Availability: 1 check, the latest on 27 September 2026: the link answers (HTTP 200)

27 September 2026: the link answers (HTTP 200)

3 files

Lipidomics/2025_Das_reviews_metric.R, R, 5,122 lines
Sleep/DAM_2026_Das_metrics.R, R, 3,769 lines
README.md, Text, 4 lines

At the source: zenodo.org/records/20637355

jvaughen/das

License: none: the authors keep all their rights

State: the link answers, verified on 27 September 2026

Evidence: files inventoried

Commit: a60091d58874746a4ea01594d3a18f26f69e6ddc, 10 June 2026

Languages: R (2)

Size: 14 files, 2 scripts

Software Heritage: not archived

Found in: the Zenodo archive record

Holds: README

Not found: license file, CITATION.cff, environment file, tests, continuous integration, documentation

Tools: cowplot (2 files), ggplot2 (2 files), tidyverse (2 files), broom (1 file), circlize (1 file), ComplexHeatmap (1 file), emmeans (1 file), ggpubr (1 file), patchwork (1 file), rstatix (1 file)

Availability: 1 check, the latest on 27 September 2026: the link answers

27 September 2026: the link answers

3 files

Lipidomics/2025_Das_reviews_metric.R, R, 5,122 lines
Sleep/DAM_2026_Das_metrics.R, R, 3,769 lines, 1 match
README.md, Text, 4 lines

At the source: github.com/jvaughen/Das/tree/1

The paper's code and data availability statement is in the Data section.

Tracing map

Proposed by the machine: these links were found in the paper and verified at the source, without human review. The map will receive a Zenodo DOI once one of the paper's authors has validated it with their ORCID.

What the map holds:

2 repositories of the authors' code, each at its verified commit, with its license and how the link was found in the paper;
4 scripts, each with its path and the digest of its content;
1 match between paragraphs of the paper and lines of the code (method lexical-v1);
neither the text of the paper nor the code itself.

Its JSON (tracing-map.json) is deposited on Zenodo with its DOI once the map is validated.

Data

No dataset and no data link were found in the paper.

Data Availability

Lipidomics raw data generated is available at the NIH Common Fund’s National Metabolomics Data Repository (NMDR) website, the Metabolomics Workbench, https://www.metabolomicsworkbench.org, where it has been assigned Project ID #7642. The data can be accessed directly via http://dx.doi.org/10.21228/M8XK2W. Code generated and processed lipidomics data (in ng/brain and rel % composition/brain) are accessible at https://zenodo.org/records/20637355. All other relevant data can be found within the manuscript and supplemental files.

Reproduced under the paper's license (CC BY), from the paper cited above.

Versions

The history of this record: each version stored by the harvester or made by a correction of its authors or of the maintainers of its code, and what changed in its facts. The texts of the paper (its abstract, its availability statements) are not part of it; versions that changed only those are not listed.

Version 2, 28 September 2026

Authors: added John P Vaughen (0000-0002-7141-1857); Hua Bai (0000-0003-2221-7545); removed John P Vaughen; Hua Bai

Version 1, 27 September 2026: the first record

Recorded: type, language, journal, volume, issue, pages, dates, 11 authors, 13 MeSH terms, 9 funders, 108 references, 21 RRIDs.

Cite

This paper

Das, A., Rivas-Serna, I. M., Kumar, A., Sherpa, L., Huang, K., Kalita, H., Dorneich-Hayes, M., Liu, R., Mazurak, V. C., Vaughen, J. P., & Bai, H. (2026). Peroxisomal import is circadian in glia and regulates sleep and lipid metabolism. PLoS biology, 24(7), e3003901. https://doi.org/10.1371/journal.pbio.3003901

BibTeX

@article{das2026peroxisomal, author = {Das, Anurag and Rivas-Serna, Irma Magaly and Kumar, Ankur and Sherpa, Lakpa and Huang, Kerui and Kalita, Hia and Dorneich-Hayes, Marlene and Liu, Ruiqi and Mazurak, Vera C and Vaughen, John P and Bai, Hua}, title = {{Peroxisomal import is circadian in glia and regulates sleep and lipid metabolism}}, journal = {PLoS biology}, year = {2026}, month = jul, volume = {24}, number = {7}, pages = {e3003901}, publisher = {PLOS}, issn = {1544-9173}, doi = {10.1371/journal.pbio.3003901}, url = {https://doi.org/10.1371/journal.pbio.3003901}, pmid = {42455861}, pmcid = {PMC13387613} }

RIS

TY - JOUR AU - Das, Anurag AU - Rivas-Serna, Irma Magaly AU - Kumar, Ankur AU - Sherpa, Lakpa AU - Huang, Kerui AU - Kalita, Hia AU - Dorneich-Hayes, Marlene AU - Liu, Ruiqi AU - Mazurak, Vera C AU - Vaughen, John P AU - Bai, Hua TI - Peroxisomal import is circadian in glia and regulates sleep and lipid metabolism T2 - PLoS biology J2 - PLoS Biol PY - 2026 DA - 2026/07/15 VL - 24 IS - 7 SP - e3003901 SN - 1544-9173 PB - PLOS DO - 10.1371/journal.pbio.3003901 UR - https://doi.org/10.1371/journal.pbio.3003901 LA - en ER -

CSL-JSON

{ "id": "10.1371/journal.pbio.3003901", "type": "article-journal", "title": "Peroxisomal import is circadian in glia and regulates sleep and lipid metabolism", "container-title": "PLoS biology", "author": [ { "family": "Das", "given": "Anurag" }, { "family": "Rivas-Serna", "given": "Irma Magaly" }, { "family": "Kumar", "given": "Ankur" }, { "family": "Sherpa", "given": "Lakpa" }, { "family": "Huang", "given": "Kerui" }, { "family": "Kalita", "given": "Hia" }, { "family": "Dorneich-Hayes", "given": "Marlene" }, { "family": "Liu", "given": "Ruiqi" }, { "family": "Mazurak", "given": "Vera C" }, { "family": "Vaughen", "given": "John P" }, { "family": "Bai", "given": "Hua" } ], "container-title-short": "PLoS Biol", "volume": "24", "issue": "7", "page": "e3003901", "DOI": "10.1371/journal.pbio.3003901", "PMID": "42455861", "PMCID": "PMC13387613", "ISSN": "1544-9173", "publisher": "PLOS", "URL": "https://doi.org/10.1371/journal.pbio.3003901", "language": "en", "issued": { "date-parts": [ [ 2026, 7, 15 ] ] } }

The tracing map gets a citation of its own once an author has validated it and it has a DOI.

Similar papers

The papers with a page that share the most with this one: the tools found in their code, their categories, datasets, cited references and authors, the rarest counting most.

[1] doi:10.1093/bioinformatics/btag592 [code]: Network-based stratification of allele-specific expression reveals patient subgroups in Huntington's disease.
Journal: Bioinformatics (Oxford, England)
In common: rstatix, broom, circlize, 7 other tools
[2] doi:10.1073/pnas.2609132123 [code]: A human lysosomal storage disorder toolkit for decoding proteome landscapes in cortical-like and dopaminergic-like induced neurons.
Journal: Proceedings of the National Academy of Sciences of the United States of America
In common: rstatix, broom, circlize, 6 other tools, cellular / molecular
[3] doi:10.1073/pnas.2605750123: Light- and temperature-sensitive seizures are regulated by spatially distinct cortex glial populations in the central nervous system.
Journal: Proceedings of the National Academy of Sciences of the United States of America
In common: drosophila, cellular / molecular, 7 references
[4] doi:10.1038/s41467-026-74753-y [code]: A human-specific microRNA controls the timing of excitatory synaptogenesis.
Journal: Nature communications
In common: rstatix, circlize, emmeans, 6 other tools, cellular / molecular
[5] doi:10.1038/s41386-026-02406-1 [code]: Functional genomic profiling of schizophrenia-associated genes reveals key microglial regulators.
Journal: Neuropsychopharmacology : official publication of the American College of Neuropsychopharmacology
In common: broom, circlize, emmeans, 5 other tools, cellular / molecular
[6] doi:10.1002/imt2.70163 [code]: Spatial multi-omics unveils sphingolipid metabolic reprogramming within the retinal pathological niche.
Journal: iMeta
In common: rstatix, circlize, ComplexHeatmap, 5 other tools, cellular / molecular
[7] doi:10.1038/s41467-026-76232-w [code]: Th17 effector cytokines induce shared and distinct microglial and endothelial cell responses in a mouse model for post-streptococcal encephalitis.
Journal: Nature communications
In common: rstatix, circlize, ComplexHeatmap, 5 other tools, cellular / molecular
[8] doi:10.1038/s41514-026-00391-9 [code]: Region-specific transcriptional signatures of brain aging in the absence of neuropathology at the single-cell level.
Journal: npj aging
In common: broom, circlize, ComplexHeatmap, 5 other tools, cellular / molecular
[9] doi:10.1016/j.isci.2026.115573 [code]: Female cortical cellular mosaicism underlies shared MeCP2 and PCB impacted gene pathways.
Journal: iScience
In common: broom, circlize, ComplexHeatmap, 5 other tools, cellular / molecular
[10] doi:10.1016/j.xcrm.2026.102651 [code]: Integrative CSF profiling identifies disease-specific immune responses in leptomeningeal disease.
Journal: Cell reports. Medicine
In common: broom, circlize, ComplexHeatmap, 5 other tools, cellular / molecular

Contribute

The authors of this paper can claim it, correct its record and validate its tracing map, and the maintainers of its code (its owner, or a public member of its organization) correct what it says of their repository; anyone signed in can ask for its removal. Every request goes to OSCR's own machine, which answers it; your account page follows them.

Sign in with ORCID to claim this paper as one of its authors, correct its record or validate its tracing map: when the paper's metadata lists your ORCID iD, you are recognized at once. Maintainers of its code: sign in with GitHub, then claim the repository on your account page.

Request its removal

To ask OSCR to remove this record, the copies of its authors' scripts or its tracing map, use the removal request page: signed in, you say who you are, what to remove and why, then review and confirm the request. Published rules decide every request (how).

Discussion, reproductions, activity

Discussion: questions and error reports about this paper and its code, from signed-in readers and its authors. It opens with sign-in.

Reproductions: reports from readers who ran the authors' code: what they reproduced, with which environment, commit and data. It opens with sign-in.

Activity: what happens around this paper: new versions of its record, its map's validation, discussions and reproductions. It opens with sign-in.