Skip to content

Commit

Permalink
1. Added license
Browse files Browse the repository at this point in the history 
2. Removed NSE
3. Removed magrittr and %>% pipes
  • Loading branch information
Bharath HU authored and Bharath Air committed Apr 20, 2020
1 parent cd454ca commit 840ad23
Show file tree
Hide file tree
Showing 7 changed files with 664 additions and 86 deletions.
1 change: 0 additions & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,6 @@ Encoding: UTF-8
LazyData: true
RoxygenNote: 7.0.2
Imports:
magrittr (>= 1.5),
rain (>= 1.18.0),
DODR (>= 0.99.2),
limma (>= 3.38.3)
595 changes: 595 additions & 0 deletions LICENSE.md
View file

Large diffs are not rendered by default.

2 changes: 0 additions & 2 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,4 @@
# Generated by roxygen2: do not edit by hand

export("%>%")
export(compareRhythms_model_compare)
export(compareRhythms_rain)
importFrom(magrittr,"%>%")
51 changes: 26 additions & 25 deletions R/compareRhythms_model_compare.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,18 +30,14 @@ compareRhythms_model_compare <- function(y, exp_design, period = 24,

group_id <- base::unique(exp_design$group)

exp_design <- exp_design %>%
base::transform(inphase = cos(2 * pi * time / period),
outphase = sin(2 * pi * time / period))
exp_design <- base::cbind(exp_design,
inphase = cos(2 * pi * exp_design$time / period),
outphase = sin(2 * pi * exp_design$time / period))

design <- stats::model.matrix(~0 + group + group:inphase + group:outphase,
data = exp_design) %>%
magrittr::set_colnames(gsub("group", "", colnames(.))) %>%
magrittr::set_colnames(gsub(":", "_", colnames(.)))

colnames(design) <- gsub("group", "", colnames(design)) %>% {
gsub(":", "_", .)
}
data = exp_design)
colnames(design) <- gsub("group", "", colnames(design))
colnames(design) <- gsub(":", "_", colnames(design))

design_DR <- design

Expand All @@ -52,11 +48,13 @@ compareRhythms_model_compare <- function(y, exp_design, period = 24,
colnames(design))]

design_ABR <- stats::model.matrix(~0 + group + inphase + outphase,
data = exp_design) %>%
magrittr::set_colnames(gsub("group", "", colnames(.)))
data = exp_design)

colnames(design_ABR) <- base::gsub("group", "", colnames(design_ABR))

design_noR <- stats::model.matrix(~0 + group, data = exp_design)

design_noR <- stats::model.matrix(~0 + group, data = exp_design) %>%
magrittr::set_colnames(gsub("group", "", colnames(.)))
colnames(design_noR) <- gsub("group", "", colnames(design_noR))

design_list <- list(noR = design_noR,
AR = design_AR,
Expand All @@ -66,24 +64,27 @@ compareRhythms_model_compare <- function(y, exp_design, period = 24,

model_selection <- limma::selectModel(y, design_list, criterion = criterion)

model_assignment <- with(model_selection, pref[pref != "noR"])
model_assignment <- model_selection$pref[model_selection$pref != "noR"]

model_circ_params <- lapply(design_list[-1],
model_circ_params <- base::lapply(design_list[-1],
compute_model_params, y, group_id)

circ_params <- base::vapply(model_assignment,
function(m) {
model_circ_params[[base::as.character(m)]][names(m), ]
},
FUN.VALUE = double(4)) %>% t()

results <- data.frame(circ_params) %>%
{base::cbind(symbol = names(model_assignment),
best_model = unname(model_assignment), .,
max_amp = pmax(.[, paste0(group_id[1], "_amp")],
.[, paste0(group_id[2], "_amp")]))} %>%
base::subset(max_amp > amp_cutoff) %>%
base::subset(select = -max_amp)
FUN.VALUE = double(4))

results <- data.frame(t(circ_params))
results <- base::cbind(symbol = names(model_assignment),
best_model = unname(model_assignment),
results)

results$max_amp <- pmax(results[, paste0(group_id[1], "_amp")],
results[, paste0(group_id[2], "_amp")])

results <- results[results$max_amp > amp_cutoff, ]
results$max_amp <- NULL

for (i in seq(nrow(results))) {
if (results[i, "best_model"] == "DR") {
Expand Down
88 changes: 42 additions & 46 deletions R/compareRhythms_rain.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,47 +32,46 @@ compareRhythms_rain <- function(y, exp_design, period=24, rhythm_fdr = 0.05,

group_id <- base::unique(exp_design$group)

exp_design_A <- base::subset(exp_design, group == group_id[1])
exp_design_A <- exp_design[exp_design$group == group_id[1], ]

exp_design_A <- exp_design_A[base::order(exp_design_A$time), ]

exp_design_B <- base::subset(exp_design, group == group_id[2])
exp_design_B <- exp_design[exp_design$group == group_id[2], ]

exp_design_B <- exp_design_B[base::order(exp_design_B$time), ]

deltat_A <- exp_design_A %$% base::unique(time) %>%
diff %>%
min

deltat_A <- min(diff(base::unique(exp_design_A$time)))

time_A <- base::seq(min(exp_design_A$time),
max(exp_design_A$time),
by = deltat_A)

measure_sequence_A <- base::table(exp_design_A$time) %>% {
base::vapply(time_A,
function(t) ifelse(any(names(.) == t),
.[names(.) == t],
0),
integer(1)
)
}
unique_times_A <- base::table(exp_design_A$time)

measure_sequence_A <- base::vapply(time_A,
function(t) {
ifelse(any(names(unique_times_A) == t),
unique_times_A[names(unique_times_A) == t],
0)
},
integer(1))

deltat_B <- exp_design_B %$% base::unique(time) %>%
diff %>%
min

deltat_B <- min(diff(base::unique(exp_design_B$time)))

time_B <- base::seq(min(exp_design_B$time),
max(exp_design_B$time),
by = deltat_B)

measure_sequence_B <- base::table(exp_design_B$time) %>% {
base::vapply(time_B,
function(t) ifelse(any(names(.) == t),
.[names(.) == t], 0),
unique_times_B <- base::table(exp_design_B$time)

measure_sequence_B <- base::vapply(time_B,
function(t) {
ifelse(any(names(unique_times_B) == t),
unique_times_B[names(unique_times_B) == t],
0)
},
integer(1))
}


y_A <- y[, exp_design_A$col_number]
Expand All @@ -84,21 +83,20 @@ compareRhythms_rain <- function(y, exp_design, period=24, rhythm_fdr = 0.05,
rain_B <- rain::rain(t(y_B), deltat_B, period,
measure.sequence = measure_sequence_B)

rain_results <- data.frame(p_val_adjust_A = p.adjust(rain_A[, "pVal"],
method = "BH"),
p_val_adjust_B = p.adjust(rain_B[, "pVal"],
method = "BH"))
rain_results <- data.frame(stats::p.adjust(rain_A[, "pVal"], method = "BH"),
stats::p.adjust(rain_B[, "pVal"], method = "BH"))
colnames(rain_results) <- c("p_val_adjust_A", "p_val_adjust_B")


circ_params_A <- compute_circ_params(y_A, exp_design_A$time, period = period)

circ_params_B <- compute_circ_params(y_B, exp_design_B$time, period = period)

rhythmic_in_A <- (rain_results$p_val_adjust_A < rhythm_fdr) &
(circ_params_A[, "amps"] > amp_cutoff)
(circ_params_A[, "amps"] > amp_cutoff)

rhythmic_in_B <- (rain_results$p_val_adjust_B < rhythm_fdr) &
(circ_params_B[, "amps"] > amp_cutoff)
(circ_params_B[, "amps"] > amp_cutoff)

rhythmic_in_either <- rhythmic_in_A | rhythmic_in_B

Expand All @@ -107,31 +105,29 @@ compareRhythms_rain <- function(y, exp_design, period=24, rhythm_fdr = 0.05,
}

dodr_results <- DODR::robustDODR(t(y_A[rhythmic_in_either, ]),
t(y_B[rhythmic_in_either, ]),
times1 = exp_design_A$time,
times2 = exp_design_B$time,
norm = TRUE,
period = period) %>%
base::transform(p_val_adjust = p.adjust(p.value,
method = "BH"))
t(y_B[rhythmic_in_either, ]),
times1 = exp_design_A$time,
times2 = exp_design_B$time,
norm = TRUE,
period = period)
dodr_results$p_val_adjust = stats::p.adjust(dodr_results$p.value, method = "BH")

results <- data.frame(symbol = rownames(y_A)[rhythmic_in_either],
rhythmic_in_A = rhythmic_in_A[rhythmic_in_either],
rhythmic_in_B = rhythmic_in_B[rhythmic_in_either],
diff_rhythmic = dodr_results$p_val_adjust < compare_fdr) %>%
magrittr::set_rownames(NULL)
diff_rhythmic = dodr_results$p_val_adjust < compare_fdr)
rownames(results) <- NULL

if (include_pvals) {
results <- transform(results,
p_val_adjust_A = p_val_adjust_A[rhythmic_in_either],
p_val_adjust_B = p_val_adjust_B[rhythmic_in_either],
p_val_adjust_dodr = dodr_results$p_value_adjust,
amp_A = circ_params_A[rhythmic_in_either, "amps"],
amp_B = circ_params_B[rhythmic_in_either, "amps"],
phase_A = circ_params_A[rhythmic_in_either, "phases"],
phase_B = circ_params_B[rhythmic_in_either, "phases"])
results$p_val_adjust_A = p_val_adjust_A[rhythmic_in_either]
results$p_val_adjust_B = p_val_adjust_B[rhythmic_in_either]
results$p_val_adjust_dodr = dodr_results$p_value_adjust
results$amp_A = circ_params_A[rhythmic_in_either, "amps"]
results$amp_B = circ_params_B[rhythmic_in_either, "amps"]
results$phase_A = circ_params_A[rhythmic_in_either, "phases"]
results$phase_B = circ_params_B[rhythmic_in_either, "phases"]

}

return(results)
return(results)
}
11 changes: 0 additions & 11 deletions R/utils-pipe.R
View file

This file was deleted.

2 changes: 1 addition & 1 deletion R/utils.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ compute_circ_params <- function(y, t, period) {

X <- stats::model.matrix(~inphase + outphase)

fit <- lm.fit(X, t(y))
fit <- stats::lm.fit(X, t(y))

amps <- 2 * sqrt(base::colSums(fit$coefficients[-1, ]^2))

Expand Down

0 comments on commit 840ad23

Please sign in to comment.