Merge pull request #140 from jr-leary7/dev

code quality improvements and edge case handling
jr-leary7 · Oct 11, 2023 · 27440a4 · 27440a4
2 parents 5e29e5c + 0671ed4
commit 27440a4
Show file tree

Hide file tree

Showing 9 changed files with 26 additions and 26 deletions.
diff --git a/R/GetResultsDE.R b/R/GetResultsDE.R
@@ -34,7 +34,7 @@ getResultsDE <- function(test.dyn.res = NULL,
                               function(x) {
                                 purrr::map_dfr(x,
                                                function(y) {
-                                                 as.data.frame(rbind(y[c(1:12)])) %>%
+                                                 as.data.frame(rbind(y[1:12])) %>%
                                                    dplyr::mutate(dplyr::across(tidyselect::everything(), \(z) unname(unlist(z))))
                                                })
                               }) %>%

diff --git a/R/clusterGenes.R b/R/clusterGenes.R
@@ -50,7 +50,7 @@ clusterGenes <- function(test.dyn.res = NULL,
   if (!clust.algo %in% c("hclust", "kmeans", "leiden")) { stop("clust.algo must be one of 'hclust', 'kmeans', or 'leiden'.") }
   if ((use.pca & is.null(n.PC)) || (use.pca & n.PC <= 0)) { stop("n.PC must be a non-zero integer when clustering on principal components.") }
   if (is.null(lineages)) {
-    lineages <- LETTERS[seq(length(test.dyn.res[[1]]))]
+    lineages <- LETTERS[seq_along(test.dyn.res[[1]])]
   }
   gene_cluster_list <- vector("list", length = length(lineages))
   for (l in seq_along(lineages)) {

diff --git a/R/fitGLMM.R b/R/fitGLMM.R
@@ -60,7 +60,7 @@ fitGLMM <- function(X_pred = NULL,
                                       })
     glmm_basis_df <- purrr::pmap_dfc(list(glm_marge_knots$knot,
                                           glm_marge_knots$tp_fun,
-                                          seq(nrow(glm_marge_knots))),
+                                          seq_len(nrow(glm_marge_knots))),
                                      function(k, f, i) {
                                        if (f == "tp1") {
                                          basis <- tp1(x = X_pred[, 1], t = k)

diff --git a/R/getFittedValues.R b/R/getFittedValues.R
@@ -63,8 +63,8 @@ getFittedValues <- function(test.dyn.res = NULL,
   # select sublist for gene of interest
   test.dyn.res <- test.dyn.res[genes]
   # make sure lineages are named nicely
-  colnames(pt) <- paste0("Lineage_", LETTERS[1:ncol(pt)])
-  lineages <- LETTERS[1:ncol(pt)]
+  colnames(pt) <- paste0("Lineage_", LETTERS[seq_len(ncol(pt))])
+  lineages <- LETTERS[seq_len(ncol(pt))]
   # create list of lineage-specific dataframes containing expression of each gene
   mod_df_list <- purrr::map2(pt, lineages, \(x, y) {
     mod_df <- purrr::map(genes,

diff --git a/R/marge2.R b/R/marge2.R
@@ -188,7 +188,7 @@ marge2 <- function(X_pred = NULL,
 
       in.set <- ifelse(ncol(B) > 1, sum(!var_name_vec %in% var_name), 0)
 
-      for (t in seq(length(X_red))) {
+      for (t in seq_along(X_red)) {
         # pairs of truncated functions
         b1_new <- matrix(tp1(x = X,  t = X_red[t]), ncol = 1)
         b2_new <- matrix(tp2(x = X, t = X_red[t]), ncol = 1)
@@ -260,7 +260,7 @@ marge2 <- function(X_pred = NULL,
             B2 <- as.matrix(B2[, -1, drop = FALSE])
           }
 
-          for (nn in seq(ncol(B2))) {
+          for (nn in seq_len(ncol(B2))) {
             B2a <- matrix(rep(B2[, nn], 2), ncol = 2)
             B2b <- matrix(B2[, nn], ncol = 1)
             B_new_both_int <- cbind(B, B2a * cbind(b1_new, b2_new))
@@ -374,9 +374,9 @@ marge2 <- function(X_pred = NULL,
 
       # See the LM code above in regards to what the conditions below actually do.
 
-      if (all((apply(score_knot_both_int_mat, 1, is.na))) & all((apply(score_knot_one_int_mat, 1, is.na)))) {
+      if (all((apply(score_knot_both_int_mat, 1, is.na))) && all((apply(score_knot_one_int_mat, 1, is.na)))) {
         int <- FALSE
-        if (any(!is.na(score_knot_both_add_mat)) & any(!is.na(score_knot_one_add_mat))) {
+        if (any(!is.na(score_knot_both_add_mat)) && any(!is.na(score_knot_one_add_mat))) {
           if (utils::tail(max(score_knot_both_add_mat, na.rm = TRUE), n = 1) > utils::tail(max(score_knot_one_add_mat, na.rm = TRUE), n = 1)) {
             trunc.type <- 2
             score_knot <- score_knot_both_add_mat
@@ -386,19 +386,19 @@ marge2 <- function(X_pred = NULL,
             score_knot <- score_knot_one_add_mat
             min_knot1 <- utils::tail(which(utils::tail(max(round(score_knot, 6), na.rm = TRUE), n = 1) == round(score_knot, 6), arr.ind = TRUE), n = 1)[1]
           }
-        } else if (all(is.na(score_knot_both_add_mat)) & any(!is.na(score_knot_one_add_mat))) {
+        } else if (all(is.na(score_knot_both_add_mat)) && any(!is.na(score_knot_one_add_mat))) {
           trunc.type <- 1
           score_knot <- score_knot_one_add_mat
           min_knot1 <- utils::tail(which.max(round(score_knot, 6)), n = 1)
-        } else if (any(!is.na(score_knot_both_add_mat)) & all(is.na(score_knot_one_add_mat))) {
+        } else if (any(!is.na(score_knot_both_add_mat)) && all(is.na(score_knot_one_add_mat))) {
           trunc.type <- 2
           score_knot <- score_knot_one_add_mat
           min_knot1 <- utils::tail(which.max(round(score_knot, 6)), n = 1)
         } else {
           breakFlag <- TRUE
           break
         }
-      } else if (all((apply(score_knot_both_int_mat, 1, is.na))) & any(!(apply(score_knot_one_int_mat, 1, is.na)))) {
+      } else if (all((apply(score_knot_both_int_mat, 1, is.na))) && any(!(apply(score_knot_one_int_mat, 1, is.na)))) {
         if (all(is.na(score_knot_both_add_mat))) {
           trunc.type <- 1
           if (all(is.na(score_knot_one_add_mat))) {
@@ -449,7 +449,7 @@ marge2 <- function(X_pred = NULL,
             }
           }
         }
-      } else if (any(!(apply(score_knot_both_int_mat, 1, is.na))) & all((apply(score_knot_one_int_mat, 1, is.na)))) {
+      } else if (any(!(apply(score_knot_both_int_mat, 1, is.na))) && all((apply(score_knot_one_int_mat, 1, is.na)))) {
         if (all(is.na(score_knot_both_add_mat))) {
           if (all(is.na(score_knot_one_add_mat))) {
             int <- TRUE
@@ -635,7 +635,7 @@ marge2 <- function(X_pred = NULL,
                           B_names)
 
         var_name_list1 <- vector("list")
-        for (ll in seq(ncol(B_new))) {
+        for (ll in seq_len(ncol(B_new))) {
           colnames(B_new)[ll] <- paste(var_name, colnames(B_new)[ll], sep = ":")
           var_name_list1 <- c(var_name_list1, list(colnames(B_new)[ll]))
           int.count1 <- int.count1 + 1

diff --git a/R/plotClusteredGenes.R b/R/plotClusteredGenes.R
@@ -40,15 +40,15 @@ plotClusteredGenes <- function(test.dyn.res = NULL,
                                n.cores = 2) {
   # check inputs
   if (is.null(test.dyn.res) || is.null(gene.clusters) || is.null(pt)) { stop("Arguments to plotClusteredGenes() are missing.") }
-  colnames(pt) <- paste0("Lineage_", LETTERS[1:ncol(pt)])
+  colnames(pt) <- paste0("Lineage_", LETTERS[seq_len(ncol(pt))])
   if (parallel.exec) {
     future::plan(future::multisession, workers = n.cores)
   } else {
     future::plan(future::sequential)
   }
   furrr::future_imap(test.dyn.res, function(x, y) {
     df_list <- vector("list", ncol(pt))
-    for (l in seq(ncol(pt))) {
+    for (l in seq_len(ncol(pt))) {
       lineage_name <- colnames(pt)[l]
       if (grepl("MARGE model error", x[[lineage_name]]$Model_Status)) {
         fitted_vals_mat <- data.frame(GENE = character(),

diff --git a/R/plotModels.R b/R/plotModels.R
@@ -92,10 +92,10 @@ plotModels <- function(test.dyn.res = NULL,
   # select sublist for gene of interest
   td_res <- test.dyn.res[[gene]]
   # make sure lineages are named nicely
-  colnames(pt) <- paste0("Lineage_", LETTERS[1:ncol(pt)])
+  colnames(pt) <- paste0("Lineage_", LETTERS[seq_len(ncol(pt))])
   # create base list w/ elements being lineage-specific dataframes
   counts_df_list <- purrr::map2(pt,
-                                LETTERS[1:ncol(pt)],
+                                LETTERS[seq_len(ncol(pt))],
                                 \(x, y) {
                                   mod_df <- data.frame(CELL = rownames(pt)[!is.na(x)],
                                                        LINEAGE = y,

diff --git a/R/sortGenesHeatmap.R b/R/sortGenesHeatmap.R
@@ -29,7 +29,7 @@ sortGenesHeatmap <- function(heatmap.mat = NULL, pt.vec = NULL) {
   if (!is.numeric(pt.vec) || any(is.na(pt.vec))) { stop("pt.vec must be a numeric vector with no NA values.") }
 
   # identify point at which peak expression occurs for each gene across pseudotime
-  gene_peak_order <- purrr::map(seq(ncol(heatmap.mat)), \(x) {
+  gene_peak_order <- purrr::map(seq_len(ncol(heatmap.mat)), \(x) {
     data.frame(gene = colnames(heatmap.mat)[x],
                pt = pt.vec,
                mRNA = heatmap.mat[, x]) %>%

diff --git a/R/stripGLM.R b/R/stripGLM.R
@@ -19,18 +19,18 @@ stripGLM <- function(glm.obj = NULL) {
   if (!inherits(glm.obj, "glm")) { stop("Input to stripGLM() must be of class glm.") }
 
   # strip out unnecessary glm pieces
-  glm.obj$effects <- c()
-  glm.obj$weights <- c()
-  glm.obj$residuals <- c()
-  glm.obj$prior.weights <- c()
-  glm.obj$fitted.values <- c()
+  glm.obj$effects <- NULL
+  glm.obj$weights <- NULL
+  glm.obj$residuals <- NULL
+  glm.obj$prior.weights <- NULL
+  glm.obj$fitted.values <- NULL
 
   # if glm() wasn't run with model = FALSE and y = FALSE (defaults for scLANE)
   if ("model" %in% names(glm.obj)) {
-    glm.obj$model <- c()
+    glm.obj$model <- NULL
   }
   if ("y" %in% names(glm.obj)) {
-    glm.obj$y <- c()
+    glm.obj$y <- NULL
   }
 
   return(glm.obj)