🔖 add transform_seg_table and release to CRAN

CRAN-RELEASE

@@ -1,2 +1,2 @@
-This package was submitted to CRAN on 2020-06-17.
-Once it is accepted, delete this file and tag the release (commit 7a1f5431a0).
+This package was submitted to CRAN on 2020-08-25.
+Once it is accepted, delete this file and tag the release (commit f750974add).

NAMESPACE

@@ -81,6 +81,7 @@ export(sigprofiler_extract)
 export(sigprofiler_import)
 export(sym)
 export(syms)
+export(transform_seg_table)
 export(use_color_style)
 exportClasses(CopyNumber)
 exportClasses(MAF)

NEWS.md

@@ -1,5 +1,6 @@
 # sigminer 1.0.12
 
+- Added `transform_seg_table()`.
 - Added `show_cn_group_profile()`.
 - Added `show_cn_freq_circos()`.
 - `sig_orders` option in `show_sig_profile()` function now can select and order signatures to plot.

R/show_cn_circos.R

@@ -38,7 +38,7 @@
 show_cn_circos <- function(data, samples = NULL,
                            show_title = TRUE,
                            chrs = paste0("chr", 1:22),
-                           genome_build = c("hg19", "hg38"),
+                           genome_build = c("hg19", "hg38", "mm10"),
                            col = NULL,
                            side = "inside",
                            ...) {

R/show_cn_freq_circos.R

@@ -34,7 +34,7 @@ show_cn_freq_circos <- function(data,
                                 resolution_factor = 1L,
                                 title = c("AMP", "DEL"),
                                 chrs = paste0("chr", 1:22),
-                                genome_build = c("hg19", "hg38"),
+                                genome_build = c("hg19", "hg38", "mm10"),
                                 cols = NULL,
                                 plot_ideogram = TRUE,
                                 track_height = 0.5,

R/show_cn_group_profile.R

@@ -44,7 +44,7 @@ show_cn_group_profile <- function(data,
                                   fill_area = TRUE,
                                   cols = NULL,
                                   chrs = paste0("chr", c(1:22, "X")),
-                                  genome_build = c("hg19", "hg38"),
+                                  genome_build = c("hg19", "hg38", "mm10"),
                                   cutoff = 2L,
                                   resolution_factor = 1L,
                                   force_y_limit = TRUE,

R/show_cn_profile.R

@@ -31,7 +31,7 @@
 #' expect_s3_class(p, "ggplot")
 show_cn_profile <- function(data, samples = NULL, show_n = NULL, show_title = FALSE,
                             chrs = paste0("chr", 1:22),
-                            genome_build = c("hg19", "hg38"),
+                            genome_build = c("hg19", "hg38", "mm10"),
                             nrow = NULL, ncol = NULL, return_plotlist = FALSE) {
   stopifnot(is.data.frame(data) | inherits(data, "CopyNumber"))
   if (is.data.frame(data)) {

R/transform_seg_table.R

@@ -0,0 +1,111 @@
+#' Transform Copy Number Table
+#'
+#' @inheritParams get_cn_freq_table
+#' @inheritParams tidyr::pivot_wider
+#' @param ref_type annotation data type used for constructing matrix.
+#'
+#' @return a `data.table`.
+#' @export
+#'
+#' @examples
+#' load(system.file("extdata", "toy_copynumber.RData",
+#'   package = "sigminer", mustWork = TRUE
+#' ))
+#' # Compute the mean segVal in each cytoband
+#' x <- transform_seg_table(cn, resolution_factor = 1)
+#' x
+#' # Compute the mean segVal in each half-cytoband
+#' x2 <- transform_seg_table(cn, resolution_factor = 2)
+#' x2
+#' @testexamples
+#' expect_is(x, "data.table")
+#' expect_is(x2, "data.table")
+transform_seg_table <- function(data,
+                                genome_build = c("hg19", "hg38", "mm10"),
+                                ref_type = c("cytoband", "gene"),
+                                values_fill = NA,
+                                values_fn = function(x, ...) {
+                                  round(mean(x, ...))},
+                                resolution_factor = 1L) {
+
+  stopifnot(is.data.frame(data) | inherits(data, "CopyNumber"))
+  if (is.data.frame(data)) {
+    nc_cols <- c("chromosome", "start", "end", "segVal", "sample")
+    if (!all(nc_cols %in% colnames(data))) {
+      stop("Invalid input, it must contain columns: ", paste(nc_cols, collapse = " "))
+    }
+  }
+
+  genome_build <- match.arg(genome_build)
+  if (inherits(data, "CopyNumber")) {
+    genome_build <- data@genome_build
+    data <- data@data
+  } else {
+    data <- data.table::as.data.table(data)
+  }
+
+  ref_type <- match.arg(ref_type)
+
+  #data$sample <- factor(data$sample, levels = unique(data$sample))
+  data$chromosome <- ifelse(startsWith(data$chromosome, prefix = "chr"),
+                            data$chromosome,
+                            paste0("chr", data$chromosome))
+
+  if (ref_type == "cytoband") {
+    annot <- get_genome_annotation(
+      data_type = "cytobands",
+      genome_build = genome_build
+    )
+    annot$start <- annot$start + 1L
+  } else {
+    if (genome_build == "mm10") {
+      # Not support for now
+      annot_file <- system.file("extdata", "mouse_mm10_gene_info.rds",
+                                package = "sigminer", mustWork = TRUE)
+    } else {
+      annot_file <- system.file("extdata", paste0("human_", genome_build, "_gene_info.rds"),
+                                package = "sigminer", mustWork = TRUE)
+    }
+
+    annot <- readRDS(annot_file)
+    annot <- annot[, c("chrom", "start", "end", "gene_name", "gene_type")]
+    colnames(annot)[4] <- "band"
+  }
+
+
+  data.table::setDT(annot)
+  ## Control the resolution
+  if (resolution_factor > 1) {
+    f <- function(x, y, n, chrom, band) {
+      helper_create_chunks(x, y,
+                           n = n,
+                           chrom = chrom,
+                           band = paste(band, seq_len(n), sep = "-chunk-")
+      )
+    }
+    annot <- purrr::pmap_df(
+      data.frame(
+        x = annot$start,
+        y = annot$end,
+        n = resolution_factor,
+        chrom = annot$chrom,
+        band = annot$band
+      ),
+      .f = f
+    ) %>%
+      data.table::as.data.table() %>%
+      data.table::setcolorder(c("chrom", "start", "end", "band"))
+  }
+  data.table::setkey(annot, chrom, start, end)
+  merge_dt <- data.table::foverlaps(data, annot,
+                                    by.x = c("chromosome", "start", "end")
+  )
+  merge_dt <- merge_dt %>%
+    dplyr::as_tibble() %>%
+    dplyr::select(-c("i.start", "i.end")) %>%
+    na.omit() %>%
+    tidyr::pivot_wider(names_from = "sample", values_from = "segVal",
+                       values_fill = values_fill, values_fn = values_fn)
+  colnames(merge_dt)[4] <- "label"
+  merge_dt %>% data.table::as.data.table()
+}

_pkgdown.yml

@@ -112,6 +112,7 @@ reference:
   - title: Copy number analysis and visualization
     desc: Functions for analyzing copy number data and visualization.
     contents:
+    - transform_seg_table
     - get_cn_ploidy
     - scoring
     - show_cn_profile

data-raw/mouse_genome.R

@@ -101,4 +101,19 @@ mm10$width <- NULL
 transcript.mm10 <- mm10
 usethis::use_data(transcript.mm10, overwrite = TRUE)
 
-## Currently, I don't use gene location data, so don't generate it for now.
+# Gene --------------------------------------------------------------------
+
+## mm10 gene
+gtf_mm10 <- data.table::fread("data-raw/mm10.annotation.gtf.gz", skip = 5, sep = "\t", header = FALSE)
+
+gtf_mm10[, `:=`(
+  gene_name = extract_col(V9, "gene_name"),
+  gene_id = extract_col(V9, "gene_id"),
+  gene_type = extract_col(V9, "gene_type")
+)]
+
+gene_mm10 <- gtf_mm10[V3 == "gene", .(V1, V4, V5, V7, gene_name, gene_id, gene_type)]
+colnames(gene_mm10)[1:4] <- c("chrom", "start", "end", "strand")
+
+## Save to extdata
+saveRDS(gene_mm10, file = "inst/extdata/mouse_mm10_gene_info.rds")