Auto-style code

LieberInstitute · Nov 5, 2024 · cd8facb · cd8facb
1 parent 992b450
commit cd8facb
Show file tree

Hide file tree

Showing 16 changed files with 212 additions and 221 deletions.
diff --git a/R/DEqual.R b/R/DEqual.R
@@ -48,19 +48,19 @@
 #' ## Create the DEqual plot
 #' DEqual(random_de)
 DEqual <- function(DE, deg_tstats = qsvaR::degradation_tstats, show.legend = TRUE,
-                        show.cor = c('caption','corner-top','corner-bottom','none'),
-                        font.size = 12,  cor.size = font.size/2, cor.label = 'cor: ') {
+    show.cor = c("caption", "corner-top", "corner-bottom", "none"),
+    font.size = 12, cor.size = font.size / 2, cor.label = "cor: ") {
     ## For R CMD check
     DE_t <- degradation_t <- NULL
-    show.cor=rlang::arg_match(show.cor)
+    show.cor <- rlang::arg_match(show.cor)
     ## Check input
     if (!is.data.frame(DE)) {
-      stop("The input to DEqual is not a dataframe.", call. = FALSE)
-      }
+        stop("The input to DEqual is not a dataframe.", call. = FALSE)
+    }
     # Check if 't' is in the column names of DE
     if (!("t" %in% colnames(DE))) {
         stop("'t' is not a column in 'DE'.", call. = FALSE)
-      }
+    }
     # Check if DE has non-null row names
     if (is.null(rownames(DE))) {
         stop("Row names of 'DE' are NULL.", call. = FALSE)
@@ -81,8 +81,8 @@ DEqual <- function(DE, deg_tstats = qsvaR::degradation_tstats, show.legend = TRU
     }
 
     ## Locate common transcripts
-    whichTx <- which_tx_names(rownames(DE),rownames(deg_tstats))
-    common = qsvaR::normalize_tx_names(rownames(DE)[whichTx])
+    whichTx <- which_tx_names(rownames(DE), rownames(deg_tstats))
+    common <- qsvaR::normalize_tx_names(rownames(DE)[whichTx])
     stopifnot(length(common) > 0)
     rownames(deg_tstats) <- qsvaR::normalize_tx_names(rownames(deg_tstats))
     ## Create dataframe with common transcripts
@@ -98,20 +98,25 @@ DEqual <- function(DE, deg_tstats = qsvaR::degradation_tstats, show.legend = TRU
         scale_fill_continuous(type = "viridis") +
         theme_bw() +
         theme(text = element_text(size = font.size))
-        # labs(caption = paste0("correlation: ", cor_val)
-    if (show.cor != 'none') {
-      switch(show.cor,
-        'caption' = {
-          p <- p + labs(caption = paste0(cor.label, cor_val))
-        },
-        'corner-top' = {
-          p <- p + annotate("text", x = max(common_data$DE_t), y = max(common_data$degradation_t),
-                            label = paste0(cor.label, cor_val), size = cor.size, hjust = 1, vjust = 1)
-        },
-        'corner-bottom' = {
-          p <- p + annotate("text", x = max(common_data$DE_t), y = min(common_data$degradation_t),
-                            label = paste0(cor.label, cor_val), size = cor.size, hjust = 1, vjust = 0)
-        })
+    # labs(caption = paste0("correlation: ", cor_val)
+    if (show.cor != "none") {
+        switch(show.cor,
+            "caption" = {
+                p <- p + labs(caption = paste0(cor.label, cor_val))
+            },
+            "corner-top" = {
+                p <- p + annotate("text",
+                    x = max(common_data$DE_t), y = max(common_data$degradation_t),
+                    label = paste0(cor.label, cor_val), size = cor.size, hjust = 1, vjust = 1
+                )
+            },
+            "corner-bottom" = {
+                p <- p + annotate("text",
+                    x = max(common_data$DE_t), y = min(common_data$degradation_t),
+                    label = paste0(cor.label, cor_val), size = cor.size, hjust = 1, vjust = 0
+                )
+            }
+        )
     }
     return(p)
 }
diff --git a/R/getDegTx.R b/R/getDegTx.R
@@ -34,39 +34,38 @@
 #' @examples
 #' degTx <- getDegTx(rse_tx, "standard")
 getDegTx <- function(rse_tx, type = c("cell_component", "standard", "top1500"),
-                     sig_transcripts = NULL, assayname = "tpm", verbose = TRUE) {
-
-  #type = arg_match(type)
-  if (is.null(sig_transcripts)) {
-    type = arg_match(type)
-    sig_transcripts <- select_transcripts(type)
-  } else {
-    type = "custom"
-  }
-  # Validate rse_tx is a RangedSummarizedExperiment object
-  if (!is(rse_tx, "RangedSummarizedExperiment")) {
-    stop("'rse_tx' must be a RangedSummarizedExperiment object.", call. = FALSE)
-  }
+    sig_transcripts = NULL, assayname = "tpm", verbose = TRUE) {
+    # type = arg_match(type)
+    if (is.null(sig_transcripts)) {
+        type <- arg_match(type)
+        sig_transcripts <- select_transcripts(type)
+    } else {
+        type <- "custom"
+    }
+    # Validate rse_tx is a RangedSummarizedExperiment object
+    if (!is(rse_tx, "RangedSummarizedExperiment")) {
+        stop("'rse_tx' must be a RangedSummarizedExperiment object.", call. = FALSE)
+    }
 
-  # Check if assayname is in assayNames
-  if (!assayname %in% assayNames(rse_tx)) {
-    stop(sprintf("'%s' is not in assayNames(rse_tx).", assayname), call. = FALSE)
-  }
+    # Check if assayname is in assayNames
+    if (!assayname %in% assayNames(rse_tx)) {
+        stop(sprintf("'%s' is not in assayNames(rse_tx).", assayname), call. = FALSE)
+    }
 
-  # Check for validity and matching of tx names and return the tx subset indexes in rse_tx
-  wtx <- which_tx_names(rownames(rse_tx), sig_transcripts)
-  if (length(wtx) == 0) {
-    stop("No transcripts found in the '",type, "' degradation model transcripts" )
-  }
+    # Check for validity and matching of tx names and return the tx subset indexes in rse_tx
+    wtx <- which_tx_names(rownames(rse_tx), sig_transcripts)
+    if (length(wtx) == 0) {
+        stop("No transcripts found in the '", type, "' degradation model transcripts")
+    }
 
-  if (verbose) {
-      message("   '",type,"' degradation model transcripts found: ", length(wtx))
-  }
-  rse_tx <- rse_tx[wtx, , drop = FALSE]
+    if (verbose) {
+        message("   '", type, "' degradation model transcripts found: ", length(wtx))
+    }
+    rse_tx <- rse_tx[wtx, , drop = FALSE]
 
-  # Check if the row means is greater than 1
-  if (mean(rowMeans(assays(rse_tx)[[assayname]])) < 1) {
-    warning("The transcripts selected are lowly expressed in your dataset. This can impact downstream analysis.")
+    # Check if the row means is greater than 1
+    if (mean(rowMeans(assays(rse_tx)[[assayname]])) < 1) {
+        warning("The transcripts selected are lowly expressed in your dataset. This can impact downstream analysis.")
     }
-  return(rse_tx)
+    return(rse_tx)
 }
diff --git a/R/getPCs.R b/R/getPCs.R
@@ -13,16 +13,15 @@
 #' @examples
 #' getPCs(rse_tx, "tpm")
 getPCs <- function(rse_tx, assayname = "tpm") {
-
-  # Validate rse_tx is a RangedSummarizedExperiment object
-  if (!is(rse_tx, "RangedSummarizedExperiment")) {
-    stop("'rse_tx' must be a RangedSummarizedExperiment object.", call. = FALSE)
-  }
-
-  # Check if assayname is in assayNames
-  if (!assayname %in% assayNames(rse_tx)) {
-    stop(sprintf("'%s' is not in assayNames(rse_tx).", assayname), call. = FALSE)
-  }
-  # Compute PCs
-  qsvPCs <- prcomp(t(log2(assays(rse_tx)[[assayname]] + 1)))
+    # Validate rse_tx is a RangedSummarizedExperiment object
+    if (!is(rse_tx, "RangedSummarizedExperiment")) {
+        stop("'rse_tx' must be a RangedSummarizedExperiment object.", call. = FALSE)
+    }
+
+    # Check if assayname is in assayNames
+    if (!assayname %in% assayNames(rse_tx)) {
+        stop(sprintf("'%s' is not in assayNames(rse_tx).", assayname), call. = FALSE)
+    }
+    # Compute PCs
+    qsvPCs <- prcomp(t(log2(assays(rse_tx)[[assayname]] + 1)))
 }
diff --git a/R/get_qsvs.R b/R/get_qsvs.R
@@ -15,18 +15,17 @@
 #' qsv <- getPCs(rse_tx, "tpm")
 #' get_qsvs(qsv, 2)
 get_qsvs <- function(qsvPCs, k) {
-
-  #Validate qsvPCs is a prcomp object
-  if (!is(qsvPCs, "prcomp")) {
-    stop("'qsvPCs' must be a prcomp object.", call. = FALSE)
-  }
+    # Validate qsvPCs is a prcomp object
+    if (!is(qsvPCs, "prcomp")) {
+        stop("'qsvPCs' must be a prcomp object.", call. = FALSE)
+    }
 
-  # check that k isn't zero
-  if (k <= 0 | k > ncol(qsvPCs$x)) {
-    stop(paste("k must between 1 and",ncol(qsvPCs$x)))
-  }
-  
-  qSVs <- qsvPCs$x[, seq_len(k), drop = FALSE]
-  colnames(qSVs) <- paste0("qSV", seq_len(k))
-  return(qSVs)
+    # check that k isn't zero
+    if (k <= 0 | k > ncol(qsvPCs$x)) {
+        stop(paste("k must between 1 and", ncol(qsvPCs$x)))
+    }
+
+    qSVs <- qsvPCs$x[, seq_len(k), drop = FALSE]
+    colnames(qSVs) <- paste0("qSV", seq_len(k))
+    return(qSVs)
 }
diff --git a/R/k_qsvs.R b/R/k_qsvs.R
@@ -27,47 +27,45 @@
 #' set.seed(20230621)
 #' k_qsvs(rse_tx, mod, "tpm")
 k_qsvs <- function(rse_tx, mod, assayname) {
-
-  # Validate rse_tx is a RangedSummarizedExperiment object
-  if (!is(rse_tx, "RangedSummarizedExperiment")) {
-    stop("'rse_tx' must be a RangedSummarizedExperiment object.", call. = FALSE)
-  }
-
-  # Check if assayname is in assayNames
-  if (!assayname %in% assayNames(rse_tx)) {
-    stop(sprintf("'%s' is not in assayNames(rse_tx).", assayname), call. = FALSE)
-  }
-
-  # Check if mod is a matrix
-  if (!is(mod, "matrix")) {
-    stop("'mod' must be a matrix.", call. = FALSE)
-  }
-
-  # Check if mod is full rank
-  if (qr(mod)$rank != ncol(mod)) {
-    stop("The 'mod' matrix is not full rank.", call. = FALSE)
-  }
-  if (nrow(mod) != ncol(rse_tx)) {
-    stop("The number of rows in 'mod' does not match the number of input 'rse_tx' columns.", call. = FALSE)
-  }
-
-  # Get expression data normalized by log2
-  expr <- log2(assays(rse_tx)[[assayname]] + 1)
-
-  # Run num.sv
-  k <- tryCatch(
-    num.sv(expr, mod),
-    error = function(e) {
-
-      if (grepl("only 0's may be mixed with negative subscripts", e$message)) {
-        warning("Could not run sva::num.sv(). Likely due to transcripts being not expressed in most samples.", call. = FALSE)
-      } else if (grepl("system is computationally singular", e$message)) {
-        warning("Could not run sva::num.sv(). Likely due to having highly correlated variables in your 'mod'.", call. = FALSE)
-      } else {
-        warning("Could not run sva::num.sv().", call. = FALSE)
-      }
-      stop(e)
+    # Validate rse_tx is a RangedSummarizedExperiment object
+    if (!is(rse_tx, "RangedSummarizedExperiment")) {
+        stop("'rse_tx' must be a RangedSummarizedExperiment object.", call. = FALSE)
     }
-  )
-  return(k)
+
+    # Check if assayname is in assayNames
+    if (!assayname %in% assayNames(rse_tx)) {
+        stop(sprintf("'%s' is not in assayNames(rse_tx).", assayname), call. = FALSE)
+    }
+
+    # Check if mod is a matrix
+    if (!is(mod, "matrix")) {
+        stop("'mod' must be a matrix.", call. = FALSE)
+    }
+
+    # Check if mod is full rank
+    if (qr(mod)$rank != ncol(mod)) {
+        stop("The 'mod' matrix is not full rank.", call. = FALSE)
+    }
+    if (nrow(mod) != ncol(rse_tx)) {
+        stop("The number of rows in 'mod' does not match the number of input 'rse_tx' columns.", call. = FALSE)
+    }
+
+    # Get expression data normalized by log2
+    expr <- log2(assays(rse_tx)[[assayname]] + 1)
+
+    # Run num.sv
+    k <- tryCatch(
+        num.sv(expr, mod),
+        error = function(e) {
+            if (grepl("only 0's may be mixed with negative subscripts", e$message)) {
+                warning("Could not run sva::num.sv(). Likely due to transcripts being not expressed in most samples.", call. = FALSE)
+            } else if (grepl("system is computationally singular", e$message)) {
+                warning("Could not run sva::num.sv(). Likely due to having highly correlated variables in your 'mod'.", call. = FALSE)
+            } else {
+                warning("Could not run sva::num.sv().", call. = FALSE)
+            }
+            stop(e)
+        }
+    )
+    return(k)
 }
diff --git a/R/qSVA.R b/R/qSVA.R
@@ -35,25 +35,24 @@
 #' qSVA(rse_tx = rse_tx, type = "cell_component", mod = mod, assayname = "tpm")
 #'
 qSVA <-
-    function(rse_tx,  type = c("cell_component", "standard", "top1500"),
-                      sig_transcripts = NULL,    mod,   assayname) {
+    function(rse_tx, type = c("cell_component", "standard", "top1500"),
+    sig_transcripts = NULL, mod, assayname) {
+        if (is.null(sig_transcripts)) {
+            type <- arg_match(type) # must be one of those in the list if sig_transcripts is NULL
+        }
 
-      if (is.null(sig_transcripts)) {
-        type = arg_match(type) # must be one of those in the list if sig_transcripts is NULL
-      }
+        # Validate rse_tx is a RangedSummarizedExperiment object
+        if (!is(rse_tx, "RangedSummarizedExperiment")) {
+            stop("'rse_tx' must be a RangedSummarizedExperiment object.", call. = FALSE)
+        }
 
-      # Validate rse_tx is a RangedSummarizedExperiment object
-      if (!is(rse_tx, "RangedSummarizedExperiment")) {
-        stop("'rse_tx' must be a RangedSummarizedExperiment object.", call. = FALSE)
-      }
+        # Check if assayname is in assayNames
+        if (!assayname %in% assayNames(rse_tx)) {
+            stop(sprintf("'%s' is not in assayNames(rse_tx).", assayname), call. = FALSE)
+        }
 
-      # Check if assayname is in assayNames
-      if (!assayname %in% assayNames(rse_tx)) {
-        stop(sprintf("'%s' is not in assayNames(rse_tx).", assayname), call. = FALSE)
-      }
-
-      # Get the qSVs
-      DegTx <-
+        # Get the qSVs
+        DegTx <-
             getDegTx(rse_tx, type = type, sig_transcripts = sig_transcripts, assayname = assayname)
         PCs <- getPCs(DegTx, assayname)
         k <- k_qsvs(DegTx, mod = mod, assayname = assayname)

diff --git a/R/utils.R b/R/utils.R
@@ -1,5 +1,3 @@
-
-
 #' Remove version number from Gencode/Ensembl transcript names
 #'
 #' This function removes the Gencode/ENSEMBL version from the transcript ID, while protecting _PAR_Y suffixes if present
@@ -13,10 +11,9 @@
 #' @export
 #'
 #' @examples
-#' ensIDs <-  normalize_tx_names(rownames(rse_tx))
-
+#' ensIDs <- normalize_tx_names(rownames(rse_tx))
 normalize_tx_names <- function(txnames) {
-  sub('(ENST\\d+)\\.\\d+(.*)$','\\1\\2', txnames, perl=TRUE)
+    sub("(ENST\\d+)\\.\\d+(.*)$", "\\1\\2", txnames, perl = TRUE)
 }
 
 
@@ -35,21 +32,19 @@ normalize_tx_names <- function(txnames) {
 #' @export
 #'
 #' @examples
-#' sig_tx <-  select_transcripts("cell_component")
+#' sig_tx <- select_transcripts("cell_component")
 #' whichTx <- which_tx_names(rownames(rse_tx), sig_tx)
-
-which_tx_names = function(txnames, sig_tx) {
-  ## Between releases 25 and 43, PAR genes and transcripts had the "_PAR_Y" suffix appended to their identifiers.
-  ## Since release 44, these have their own IDs
-  if (!all(grepl("^ENST\\d+", txnames))) {
-    stop("The transcript names must be ENSEMBL or Gencode IDs (ENST...)" )
-  }
-  if (!all(grepl("^ENST\\d+", sig_tx))) {
-    stop("The signature transcript names must be ENSEMBL or Gencode IDs (ENST...)" )
-  }
-  ## normalize the transcript names
-  r_tx <- normalize_tx_names(txnames)
-  s_tx <- normalize_tx_names(sig_tx)
-  which(r_tx %in% s_tx)
+which_tx_names <- function(txnames, sig_tx) {
+    ## Between releases 25 and 43, PAR genes and transcripts had the "_PAR_Y" suffix appended to their identifiers.
+    ## Since release 44, these have their own IDs
+    if (!all(grepl("^ENST\\d+", txnames))) {
+        stop("The transcript names must be ENSEMBL or Gencode IDs (ENST...)")
+    }
+    if (!all(grepl("^ENST\\d+", sig_tx))) {
+        stop("The signature transcript names must be ENSEMBL or Gencode IDs (ENST...)")
+    }
+    ## normalize the transcript names
+    r_tx <- normalize_tx_names(txnames)
+    s_tx <- normalize_tx_names(sig_tx)
+    which(r_tx %in% s_tx)
 }
-