diff --git a/DESCRIPTION b/DESCRIPTION
index 35d9e64..8aad0dd 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: scRNAtoolVis
Title: Making ScRNA-seq Visualization More Easier and Better
-Version: 0.0.7
+Version: 0.1.0
Authors@R:
person("Jun", "Zhang", , "3219030654@stu.cpu.edu.cn", role = c("aut", "cre"),
comment = c(ORCID = "YOUR-ORCID-ID"))
@@ -8,7 +8,7 @@ Description: Some useful functions to visualize scRNA-seq figures.
License: MIT + file LICENSE
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
Remotes:
junjunlab/jjAnno,
junjunlab/jjPlot,
diff --git a/NAMESPACE b/NAMESPACE
index b52a1e4..9c2ec49 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,15 +1,15 @@
# Generated by roxygen2: do not edit by hand
export("%>%")
-export(AverageHeatmap)
-export(FeatureCornerAxes)
+export(averageHeatmap)
export(cellRatioPlot)
export(clusterCornerAxes)
export(drawLegend)
+export(featureCornerAxes)
export(featurePlot)
export(jjDotPlot)
export(jjVolcano)
-export(markerVocalno)
+export(markerVolcano)
export(scatterCellPlot)
export(tracksPlot)
import(Seurat)
diff --git a/R/AverageHeatmap.R b/R/AverageHeatmap.R
deleted file mode 100644
index 333ea9f..0000000
--- a/R/AverageHeatmap.R
+++ /dev/null
@@ -1,215 +0,0 @@
-#' @name AverageHeatmap
-#' @author Junjun Lao
-#' @title Plot averaged gene expression cross cluster cells
-#' @param object object seurat object.
-#' @param markerGene Your marker genes.
-#' @param group.by Categories for grouping (e.g, ident, replicate, celltype). 'ident' by default.
-#' @param assays Which assays to use. Default is "RNA" assays.
-#' @param slot Slot(s) to use. Default is "data"
-#' @param htCol Heatmap colors. Default is c("#0099CC", "white", "#CC0033").
-#' @param colseed Cluster annotaion colors seed, these colors are produed randomly, so you can give a seed to assure produce same colors. Default is 666.
-#' @param htRange Heatmap values range. Default is c(-2, 0, 2).
-#' @param annoCol Whether use your own annotation clusters colors. Default is 'FALSE'.
-#' @param myanCol You can specify your own annotation clusters colors vectors. Default is 'null'.
-#' @param annoColType Cluster annotaion colors type (bright, light, dark and random). Default is light.
-#' @param annoColTypeAlpha Cluster annotaion colors transparency. Default is 0.
-#' @param row_title Heatmap row title. Default is "Cluster top Marker genes".
-#' @param row_names_side Heatmap gene name side. Default is "left".
-#' @param border Whether to shOw heatmap border. Default is "FALSE".
-#' @param fontsize Heatmap gene name fontsize. Default is 10.
-#' @param column_names_rot Cluster name rotation. Default is 45.
-#' @param showRowNames whether to show rownames. Default is "TRUE".
-#' @param markGenes Provide your tartget genes to mark on the plot. Default is "NULL".
-#' @param clusterAnnoName Whether to add clsuetr column annotation name. Default is "TRUE".
-#' @param width The heatmap body width. Default is "NULL".
-#' @param height The heatmap body height. Default is "NULL".
-#' @param cluster.order The cell clusters order. Default is "NULL".
-#'
-#' @param cluster_columns Whether cluster columns. Default is "FALSE".
-#' @param cluster_rows Whether cluster rows. Default is "FALSE".
-#' @param gene.order the gene orders for heatmap. Default is "NULL".
-#'
-#' @param ... Other arguments passed with ComplexHeatmap::rowAnnotation and ComplexHeatmap::Heatmap.
-#' @return Return a plot.
-#' @export
-#'
-#' @examples
-#' httest <- system.file("extdata", "htdata.RDS", package = "scRNAtoolVis")
-#' pbmc <- readRDS(httest)
-#'
-#' # load markergene
-#' markergene <- system.file("extdata", "top5pbmc.markers.csv", package = "scRNAtoolVis")
-#' markers <- read.table(markergene, sep = ",", header = TRUE)
-#'
-#' # plot
-#' AverageHeatmap(
-#' object = pbmc,
-#' markerGene = markers$gene
-#' )
-#'
-#' # change color
-#' AverageHeatmap(
-#' object = pbmc,
-#' markerGene = markers$gene,
-#' htCol = c("#339933", "#FFCC00", "#FF0033")
-#' )
-#'
-
-# define function
-AverageHeatmap <- function(object = NULL,
- markerGene = NULL,
- group.by = "ident",
- assays = "RNA",
- slot = "data",
- htCol = c("#0099CC", "white", "#CC0033"),
- colseed = 666,
- htRange = c(-2, 0, 2),
- annoCol = FALSE,
- myanCol = NULL,
- annoColType = "light",
- annoColTypeAlpha = 0,
- row_title = "Cluster top Marker genes",
- clusterAnnoName = TRUE,
- showRowNames = TRUE,
- row_names_side = "left",
- markGenes = NULL,
- border = FALSE,
- fontsize = 10,
- column_names_rot = 45,
- width = NULL,
- height = NULL,
- cluster.order = NULL,
- cluster_columns = FALSE,
- cluster_rows = FALSE,
- gene.order = NULL,
- ...) {
- # get cells mean gene expression
- mean_gene_exp <- as.matrix(data.frame(Seurat::AverageExpression(object,
- features = markerGene,
- group.by = group.by,
- assays = assays,
- slot = slot
- )))
-
- # add colnames
- # name1 <- gsub(
- # pattern = paste0(assays, ".", sep = ""),
- # replacement = "",
- # colnames(mean_gene_exp)
- # )
- #
- # colnames(mean_gene_exp) <- gsub(
- # pattern = "\\.",
- # replacement = " ", name1
- # )
-
- colnames(mean_gene_exp) <- levels(Seurat::Idents(object))
-
- # Z-score
- htdf <- t(scale(t(mean_gene_exp), scale = T, center = T))
-
- # cluster order
- if(!is.null(cluster.order)){
- htdf <- htdf[,cluster.order]
- }
-
- # gene order
- if(!is.null(gene.order)){
- htdf <- htdf[gene.order,]
- }
-
- # color
- col_fun <- circlize::colorRamp2(htRange, htCol)
-
- # anno color
- if (annoCol == FALSE) {
- set.seed(colseed)
- anno_col <- circlize::rand_color(ncol(htdf),
- luminosity = annoColType,
- transparency = annoColTypeAlpha
- )
- print(c("Your cluster annotation color is:", anno_col))
- } else if (annoCol == TRUE) {
- # give your own color vectors
- anno_col <- myanCol
- } else {
- print("Give TRUE or FALSE paramters!")
- }
- names(anno_col) <- colnames(htdf)
-
- # top annotation
- column_ha <- ComplexHeatmap::HeatmapAnnotation(
- cluster = colnames(htdf),
- show_legend = F,
- show_annotation_name = clusterAnnoName,
- col = list(cluster = anno_col)
- )
-
- # whether mark your genes on plot
- if(!is.null(markGenes)){
- # all genes
- rowGene <- rownames(htdf)
-
- # tartget gene
- annoGene <- markGenes
-
- # get target gene index
- index <- match(annoGene,rowGene)
-
- # some genes annotation
- geneMark = ComplexHeatmap::rowAnnotation(gene = ComplexHeatmap::anno_mark(at = index,
- labels = annoGene,
- labels_gp = grid::gpar(fontface = 'italic',
- fontsize = fontsize)),
- ...)
-
- right_annotation = geneMark
- }else{
- right_annotation = NULL
- }
-
- # control heatmap width and height
- if(is.null(width) | is.null(height)){
-
- # plot
- ComplexHeatmap::Heatmap(htdf,
- name = "Z-score",
- cluster_columns = cluster_columns,
- cluster_rows = cluster_rows,
- row_title = row_title,
- # column_title = "Clusters",
- right_annotation = right_annotation,
- show_row_names = showRowNames,
- row_names_gp = grid::gpar(fontface = "italic",
- fontsize = fontsize),
- row_names_side = row_names_side,
- border = border,
- column_names_side = "top",
- column_names_rot = column_names_rot,
- top_annotation = column_ha,
- col = col_fun,
- ...)
- }else{
- # plot
- ComplexHeatmap::Heatmap(htdf,
- name = "Z-score",
- cluster_columns = F,
- cluster_rows = F,
- row_title = row_title,
- # column_title = "Clusters",
- right_annotation = right_annotation,
- show_row_names = showRowNames,
- row_names_gp = grid::gpar(fontface = "italic",
- fontsize = fontsize),
- row_names_side = row_names_side,
- border = border,
- column_names_side = "top",
- column_names_rot = column_names_rot,
- top_annotation = column_ha,
- col = col_fun,
- width = ggplot2::unit(width,"cm"),
- height = ggplot2::unit(height,"cm"),
- ...)
- }
-
-}
diff --git a/R/FeatureCornerAxes.R b/R/FeatureCornerAxes.R
deleted file mode 100644
index 7bf09aa..0000000
--- a/R/FeatureCornerAxes.R
+++ /dev/null
@@ -1,269 +0,0 @@
-#' @name FeatureCornerAxes
-#' @author Junjun Lao
-#' @title Add corner axes on seurat UMAP/tSNE gene FeaturePlot function figures
-#' @param object object seurat object.
-#' @param reduction "string",reduction type (umap/tsne).
-#' @param features "string",the gene you want to plot.
-#' @param groupFacet "string",give the column name in seurat metadata to facet plot, if it is "NULL", facet plot only by gene.
-#' @param relLength "num",the corner axis line relative length to plot axis(0-1).
-#' @param relDist "num",the relative distance of corner axis label to axis.
-#' @param aspect.ratio "num", plot width and height ratio, default NULL.
-#' @param low "string",point color with low expression.
-#' @param high "string",point color with high expression.
-#' @param axes "string",show multiple corner axis or only one (mul/one), default "mul".
-#' @param legendPos "string",legend position same as ggplot theme function, default "right".
-#' @param stripCol "string",facet balckground color, defaults "white".
-#' @param pSize "num",point size.
-#' @param arrowType "string",arrow type (open/closed), default "closed".
-#' @param lineTextcol "string",facet balckground color, default "white".
-#' @param cornerTextSize "num", the corner label text size, default is 5.
-#' @param base_size "num", theme base size, default is 14.
-#' @param themebg Another theme style, default is 'default', or 'bwCorner'.
-#' @param show.legend Whether show legend, default "TRUE".
-#' @param cornerVariable Which group corner axis to be added when "axes" set to "one", default is the first group.
-#' @param nLayout = NULL Similar to the ncol/nrow for the layout, default is the gene numbers.
-#' @param minExp Minimum expression value defined, default is NULL.
-#' @param maxExp Maxmum expression value defined, default is NULL.
-#' @return Return a ggplot.
-#' @export
-#' @examples
-#'
-#' test <- system.file("extdata", "seuratTest.RDS", package = "scRNAtoolVis")
-#'
-#' tmp <- readRDS(test)
-#'
-#' # umap
-#' FeatureCornerAxes(
-#' object = tmp, reduction = "umap",
-#' groupFacet = "orig.ident",
-#' relLength = 0.5, relDist = 0.2,
-#' features = c("Actb", "Ythdc1", "Ythdf2")
-#' )
-#'
-#' # one axes
-#' FeatureCornerAxes(
-#' object = tmp, reduction = "umap",
-#' groupFacet = "orig.ident",
-#' features = c("Actb", "Ythdc1", "Ythdf2"),
-#' relLength = 0.5, relDist = 0.2,
-#' axes = "one",
-#' lineTextcol = "grey50"
-#' )
-#'
-#' # tsne
-#' FeatureCornerAxes(
-#' object = tmp, reduction = "tsne",
-#' groupFacet = "orig.ident",
-#' relLength = 0.5, relDist = 0.2,
-#' features = c("Actb", "Ythdc1", "Ythdf2")
-#' )
-#'
-#'
-# define viriables
-globalVariables(c("x1", "y1", "linegrou", "angle", "lab", "gene_name", "scaledValue"))
-
-# define function
-FeatureCornerAxes <- function(object = NULL,
- reduction = "umap",
- features = NULL,
- groupFacet = "orig.ident",
- minExp = NULL,
- maxExp = NULL,
- relLength = 0.25,
- relDist = 0.1,
- aspect.ratio = NULL,
- low = "lightgrey",
- high = "red",
- axes = "mul",
- show.legend = TRUE,
- legendPos = "right",
- stripCol = "white",
- cornerVariable = NULL,
- nLayout = NULL,
- pSize = 1,
- arrowType = "closed",
- lineTextcol = "black",
- cornerTextSize = 3,
- base_size = 14,
- themebg = "default") {
- # make PC data
- reduc <- data.frame(Seurat::Embeddings(object, reduction = reduction))
-
- # metadata
- meta <- object@meta.data
-
- # combine
- pc12 <- cbind(reduc, meta)
-
- # get gene expression
- geneExp <- Seurat::FetchData(object = object, vars = features)
-
- # cbind
- mer <- cbind(pc12, geneExp)
-
- # merge data
- megredf <- reshape2::melt(
- mer,
- id.vars = colnames(pc12),
- variable.name = "gene_name",
- value.name = "scaledValue"
- )
-
- # data range
- range <- floor(min(min(pc12[, 1]), min(pc12[, 2])))
-
- # get botomn-left coord
- lower <- range - relDist * abs(range)
-
- # label reldist to axes
- labelRel <- relDist * abs(lower)
-
- # get relative line length
- linelen <- abs(relLength * lower) + lower
-
- # mid point
- mid <- abs(relLength * lower) / 2 + lower
-
- # give reduction type
- if (startsWith(reduction,"umap")) {
- axs_label <- paste("UMAP", 2:1, sep = "")
- } else if (startsWith(reduction,"tsne")) {
- axs_label <- paste("t-SNE", 2:1, sep = "")
- } else {
- print("Please give correct type(umap or tsne)!")
- }
-
- if (axes == "mul") {
- # axies data
- axes <- data.frame(
- "x1" = c(lower, lower, lower, linelen),
- "y1" = c(lower, linelen, lower, lower),
- "linegrou" = c(1, 1, 2, 2)
- )
- # axies label
- label <- data.frame(
- "lab" = c(axs_label),
- "angle" = c(90, 0),
- "x1" = c(lower - labelRel, mid),
- "y1" = c(mid, lower - labelRel)
- )
- } else if (axes == "one") {
- # add specific group cornner
- if(is.null(cornerVariable)){
- lev <- levels(pc12[, groupFacet])
- if(!is.null(lev)){
- firstFacet <- factor(lev[1],levels = lev)
- }else{
- firstFacet <- unique(pc12[, groupFacet])[1]
- }
- }else{
- lev <- levels(pc12[, groupFacet])
- if(!is.null(lev)){
- firstFacet <- factor(cornerVariable,levels = lev)
- }else{
- firstFacet <- cornerVariable
- }
- }
-
- # axies data
- axes <- data.frame(
- "x1" = c(lower, lower, lower, linelen),
- "y1" = c(lower, linelen, lower, lower),
- "linegrou" = c(1, 1, 2, 2),
- "group" = rep(firstFacet, 2)
- )
- # axies label
- label <- data.frame(
- "lab" = c(axs_label),
- angle = c(90, 0),
- "x1" = c(lower - labelRel, mid),
- "y1" = c(mid, lower - labelRel),
- "group" = rep(firstFacet, 2)
- )
-
- # rename group name
- colnames(axes)[4] <- groupFacet
- colnames(label)[5] <- groupFacet
- } else {
- print("Please give correct args(mul or one)!")
- }
-
- ####################################
- # set color value range
- if(is.null(minExp) & is.null(maxExp)){
- minexp <- 0
- maxexp <- round(max(megredf$scaledValue) + 1,digits = 0)
- }else{
- minexp <- minExp
- maxexp <- maxExp
- }
-
- ####################################################
- # plot
- pmain <- ggplot2::ggplot(megredf,
- ggplot2::aes(x = megredf[, 1], y = megredf[, 2])) +
- ggplot2::geom_point(ggplot2::aes(color = scaledValue),
- size = pSize,
- show.legend = show.legend) +
- ggplot2::theme_classic(base_size = base_size) +
- ggplot2::scale_color_gradient(name = "",low = low,high = high,
- limits = c(minexp,maxexp),
- na.value = high) +
- ggplot2::labs(x = "", y = "") +
- ggplot2::geom_line(data = axes,
- ggplot2::aes(x = x1, y = y1, group = linegrou),
- color = lineTextcol,
- arrow = ggplot2::arrow(length = ggplot2::unit(0.1, "inches"),
- ends = "last",
- type = arrowType)) +
- ggplot2::geom_text(data = label,
- ggplot2::aes(x = x1,y = y1,angle = angle,label = lab),
- fontface = "italic",
- color = lineTextcol,
- size = cornerTextSize) +
- ggplot2::theme(strip.background = ggplot2::element_rect(colour = NA, fill = stripCol),
- strip.text = ggplot2::element_text(size = base_size),
- strip.text.y = ggplot2::element_text(angle = 0),
- aspect.ratio = aspect.ratio,
- legend.position = legendPos,
- plot.title = ggplot2::element_text(hjust = 0.5),
- axis.line = ggplot2::element_blank(),
- axis.ticks = ggplot2::element_blank(),
- axis.text = ggplot2::element_blank())
-
- ######################################
- # plot layout
- if(is.null(nLayout)){
- nLayout = length(features)
- }else{
- nLayout = nLayout
- }
-
- ######################################
- # facet plot
- if(is.null(groupFacet)){
- p1 <- pmain +
- ggplot2::facet_wrap(facets = "gene_name",ncol = nLayout)
- }else{
- p1 <- pmain +
- ggplot2::facet_grid(facets = c("gene_name",groupFacet))
- }
-
- ######################################
- # theme style
- if (themebg == "bwCorner") {
- p2 <- p1 +
- ggplot2::theme_bw(base_size = base_size) +
- ggplot2::theme(panel.grid = ggplot2::element_blank(),
- axis.text = ggplot2::element_blank(),
- axis.ticks = ggplot2::element_blank(),
- aspect.ratio = 1,
- strip.background = ggplot2::element_rect(colour = NA, fill = stripCol))
- } else if (themebg == "default") {
- p2 <- p1
- }
-
- # output
- return(p2)
-}
-
diff --git a/R/averageHeatmap.R b/R/averageHeatmap.R
new file mode 100644
index 0000000..3bb07f3
--- /dev/null
+++ b/R/averageHeatmap.R
@@ -0,0 +1,233 @@
+#' @name averageHeatmap
+#' @author Junjun Lao
+#' @title Plot averaged gene expression cross cluster cells
+#'
+#' @param object object seurat object.
+#' @param markerGene Your marker genes.
+#' @param group.by Categories for grouping (e.g, ident, replicate, celltype). "ident" by default.
+#' @param assays Which assays to use. Default is "RNA" assays.
+#' @param slot Slot(s) to use. Default is "data".
+#' @param htCol Heatmap colors. Default is c("#0099CC", "white", "#CC0033").
+#' @param colseed Cluster annotation colors seed, these colors are produced randomly, so you can give a seed to assure produce same colors. Default is 666.
+#' @param htRange Heatmap values range. Default is c(-2, 0, 2).
+#' @param annoCol Whether use your own annotation clusters colors. Default is "FALSE".
+#' @param myanCol You can specify your own annotation clusters colors vectors. Default is "null".
+#' @param annoColType Cluster annotation colors type (bright, light, dark and random). Default is light.
+#' @param annoColTypeAlpha Cluster annotation colors transparency. Default is 0.
+#' @param row_title Heatmap row title. Default is "Cluster top Marker genes".
+#' @param row_names_side Heatmap gene name side. Default is "left".
+#' @param border Whether to shOw heatmap border. Default is "FALSE".
+#' @param fontsize Heatmap gene name fontsize. Default is 10.
+#' @param column_names_rot Cluster name rotation. Default is 45.
+#' @param showRowNames whether to show rownames. Default is "TRUE".
+#' @param markGenes Provide your tartget genes to mark on the plot. Default is "NULL".
+#' @param clusterAnnoName Whether to add clsuetr column annotation name. Default is "TRUE".
+#' @param width The heatmap body width. Default is "NULL".
+#' @param height The heatmap body height. Default is "NULL".
+#' @param cluster.order The cell clusters order. Default is "NULL".
+#'
+#' @param cluster_columns Whether cluster columns. Default is "FALSE".
+#' @param cluster_rows Whether cluster rows. Default is "FALSE".
+#' @param gene.order the gene orders for heatmap. Default is "NULL".
+#'
+#' @param ... Other arguments passed with ComplexHeatmap::rowAnnotation and ComplexHeatmap::Heatmap.
+#' @return Return a plot.
+#' @export
+#'
+#' @examples
+#' httest <- system.file("extdata", "htdata.RDS", package = "scRNAtoolVis")
+#' pbmc <- readRDS(httest)
+#'
+#' # load markergene
+#' markergene <- system.file("extdata", "top5pbmc.markers.csv", package = "scRNAtoolVis")
+#' markers <- read.table(markergene, sep = ",", header = TRUE)
+#'
+#' # plot
+#' averageHeatmap(
+#' object = pbmc,
+#' markerGene = markers$gene
+#' )
+#'
+#' # change color
+#' averageHeatmap(
+#' object = pbmc,
+#' markerGene = markers$gene,
+#' htCol = c("#339933", "#FFCC00", "#FF0033")
+#' )
+#'
+# define function
+averageHeatmap <- function(
+ object = NULL,
+ markerGene = NULL,
+ group.by = "ident",
+ assays = "RNA",
+ slot = "data",
+ htCol = c("#0099CC", "white", "#CC0033"),
+ colseed = 666,
+ htRange = c(-2, 0, 2),
+ annoCol = FALSE,
+ myanCol = NULL,
+ annoColType = "light",
+ annoColTypeAlpha = 0,
+ row_title = "Cluster top Marker genes",
+ clusterAnnoName = TRUE,
+ showRowNames = TRUE,
+ row_names_side = "left",
+ markGenes = NULL,
+ border = FALSE,
+ fontsize = 10,
+ column_names_rot = 45,
+ width = NULL,
+ height = NULL,
+ cluster.order = NULL,
+ cluster_columns = FALSE,
+ cluster_rows = FALSE,
+ gene.order = NULL,
+ ...) {
+ # get cells mean gene expression
+ mean_gene_exp <- as.matrix(
+ data.frame(
+ Seurat::AverageExpression(object,
+ features = markerGene,
+ group.by = group.by,
+ assays = assays,
+ slot = slot
+ )
+ )
+ )
+
+ # add colnames
+ # name1 <- gsub(
+ # pattern = paste0(assays, ".", sep = ""),
+ # replacement = "",
+ # colnames(mean_gene_exp)
+ # )
+ #
+ # colnames(mean_gene_exp) <- gsub(
+ # pattern = "\\.",
+ # replacement = " ", name1
+ # )
+
+ colnames(mean_gene_exp) <- levels(Seurat::Idents(object))
+
+ # Z-score
+ htdf <- t(scale(t(mean_gene_exp), scale = TRUE, center = TRUE))
+
+ # cluster order
+ if (!is.null(cluster.order)) {
+ htdf <- htdf[, cluster.order]
+ }
+
+ # gene order
+ if (!is.null(gene.order)) {
+ htdf <- htdf[gene.order, ]
+ }
+
+ # color
+ col_fun <- circlize::colorRamp2(htRange, htCol)
+
+ # anno color
+ if (annoCol == FALSE) {
+ set.seed(colseed)
+ anno_col <- circlize::rand_color(
+ ncol(htdf),
+ luminosity = annoColType,
+ transparency = annoColTypeAlpha
+ )
+ print(c("Your cluster annotation color is:", anno_col))
+ } else if (annoCol == TRUE) {
+ # give your own color vectors
+ anno_col <- myanCol
+ } else {
+ print("Give TRUE or FALSE paramters!")
+ }
+ names(anno_col) <- colnames(htdf)
+
+ # top annotation
+ column_ha <- ComplexHeatmap::HeatmapAnnotation(
+ cluster = colnames(htdf),
+ show_legend = FALSE,
+ show_annotation_name = clusterAnnoName,
+ col = list(cluster = anno_col)
+ )
+
+ # whether mark your genes on plot
+ if (!is.null(markGenes)) {
+ # all genes
+ rowGene <- rownames(htdf)
+
+ # tartget gene
+ annoGene <- markGenes
+
+ # get target gene index
+ index <- match(annoGene, rowGene)
+
+ # some genes annotation
+ geneMark <- ComplexHeatmap::rowAnnotation(
+ gene = ComplexHeatmap::anno_mark(
+ at = index,
+ labels = annoGene,
+ labels_gp = grid::gpar(
+ fontface = "italic",
+ fontsize = fontsize
+ )
+ ),
+ ...
+ )
+
+ right_annotation <- geneMark
+ } else {
+ right_annotation <- NULL
+ }
+
+ # control heatmap width and height
+ if (is.null(width) || is.null(height)) {
+ # plot
+ ComplexHeatmap::Heatmap(
+ htdf,
+ name = "Z-score",
+ cluster_columns = cluster_columns,
+ cluster_rows = cluster_rows,
+ row_title = row_title,
+ # column_title = "Clusters",
+ right_annotation = right_annotation,
+ show_row_names = showRowNames,
+ row_names_gp = grid::gpar(
+ fontface = "italic",
+ fontsize = fontsize
+ ),
+ row_names_side = row_names_side,
+ border = border,
+ column_names_side = "top",
+ column_names_rot = column_names_rot,
+ top_annotation = column_ha,
+ col = col_fun,
+ ...
+ )
+ } else {
+ # plot
+ ComplexHeatmap::Heatmap(
+ htdf,
+ name = "Z-score",
+ cluster_columns = FALSE,
+ cluster_rows = FALSE,
+ row_title = row_title,
+ # column_title = "Clusters",
+ right_annotation = right_annotation,
+ show_row_names = showRowNames,
+ row_names_gp = grid::gpar(
+ fontface = "italic",
+ fontsize = fontsize
+ ),
+ row_names_side = row_names_side,
+ border = border,
+ column_names_side = "top",
+ column_names_rot = column_names_rot,
+ top_annotation = column_ha,
+ col = col_fun,
+ width = ggplot2::unit(width, "cm"),
+ height = ggplot2::unit(height, "cm"),
+ ...
+ )
+ }
+}
diff --git a/R/cellRatioPlot.R b/R/cellRatioPlot.R
index 2f55800..9df12f2 100644
--- a/R/cellRatioPlot.R
+++ b/R/cellRatioPlot.R
@@ -13,53 +13,67 @@
#' @return a ggplot object.
#' @export
-globalVariables(c('n', 'num'))
-cellRatioPlot <- function(object = NULL,
- sample.name = NULL,
- celltype.name = NULL,
- col.width = 0.7,
- flow.alpha = 0.25,
- flow.curve = 0,
- fill.col = NULL){
+globalVariables(c("n", "num"))
+cellRatioPlot <- function(
+ object = NULL,
+ sample.name = NULL,
+ celltype.name = NULL,
+ col.width = 0.7,
+ flow.alpha = 0.25,
+ flow.curve = 0,
+ fill.col = NULL) {
# get metainfo
meta <- object@meta.data
# calculate percent ratio
ratio.info <- meta %>%
- dplyr::group_by(.data[[sample.name]],.data[[celltype.name]]) %>%
+ dplyr::group_by(.data[[sample.name]], .data[[celltype.name]]) %>%
dplyr::summarise(num = n()) %>%
- dplyr::mutate(rel_num = num/sum(num))
+ dplyr::mutate(rel_num = num / sum(num))
# color
- if(is.null(fill.col)){
- fill.col <- jjAnno::useMyCol("paired",n = length(unique(meta[,celltype.name])))
- }else{
+ if (is.null(fill.col)) {
+ fill.col <- jjAnno::useMyCol("paired", n = length(unique(meta[, celltype.name])))
+ } else {
fill.col <- fill.col
}
# plot
p <-
- ggplot2::ggplot(ratio.info,
- ggplot2::aes_string(x = sample.name,y = "rel_num")) +
- ggplot2::geom_col(ggplot2::aes_string(fill = celltype.name),
- width = col.width) +
- ggalluvial::geom_flow(ggplot2::aes_string(stratum = celltype.name,
- alluvium = celltype.name,
- fill = celltype.name),
- width = 0.5,
- alpha = flow.alpha,
- knot.pos = flow.curve) +
+ ggplot2::ggplot(
+ ratio.info,
+ ggplot2::aes_string(x = sample.name, y = "rel_num")
+ ) +
+ ggplot2::geom_col(
+ ggplot2::aes_string(fill = celltype.name),
+ width = col.width
+ ) +
+ ggalluvial::geom_flow(
+ ggplot2::aes_string(
+ stratum = celltype.name,
+ alluvium = celltype.name,
+ fill = celltype.name
+ ),
+ width = 0.5,
+ alpha = flow.alpha,
+ knot.pos = flow.curve
+ ) +
ggplot2::theme_bw() +
ggplot2::coord_cartesian(expand = 0) +
ggplot2::scale_y_continuous(labels = scales::label_percent()) +
- ggplot2::scale_fill_manual(values = fill.col,
- name = "Cell Type") +
- ggplot2::theme(panel.grid = ggplot2::element_blank(),
- axis.text = ggplot2::element_text(size = ggplot2::rel(1.2),color = 'black'),
- axis.title = ggplot2::element_text(size = ggplot2::rel(1.5),color = 'black'),
- legend.text = ggplot2::element_text(size = ggplot2::rel(1.2),color = 'black'),
- legend.title = ggplot2::element_text(size = ggplot2::rel(1.5),color = 'black')) +
- ggplot2::xlab('') + ggplot2::ylab('Cell percent ratio')
+ ggplot2::scale_fill_manual(
+ values = fill.col,
+ name = "Cell Type"
+ ) +
+ ggplot2::theme(
+ panel.grid = ggplot2::element_blank(),
+ axis.text = ggplot2::element_text(size = ggplot2::rel(1.2), color = "black"),
+ axis.title = ggplot2::element_text(size = ggplot2::rel(1.5), color = "black"),
+ legend.text = ggplot2::element_text(size = ggplot2::rel(1.2), color = "black"),
+ legend.title = ggplot2::element_text(size = ggplot2::rel(1.5), color = "black")
+ ) +
+ ggplot2::xlab("") +
+ ggplot2::ylab("Cell percent ratio")
return(p)
}
diff --git a/R/clusterCornerAxes.R b/R/clusterCornerAxes.R
index 47ed157..b636618 100644
--- a/R/clusterCornerAxes.R
+++ b/R/clusterCornerAxes.R
@@ -1,30 +1,33 @@
#' @name clusterCornerAxes
#' @author Junjun Lao
#' @title Add corner axes on seurat UMAP/tSNE cluster figures
+#'
#' @param object seurat object.
#' @param reduction "string", reduction type (umap/tsne).
#' @param groupFacet "string", give the column name in seurat metadata to facet plot.
#' @param clusterCol "string", the point color to group by,cluster name, default "seurat_clusters".
#' @param pSize "num", point size.
#' @param aspect.ratio "num", plot width and height ratio, default NULL.
-#' @param noSplit 'logic', whether to split/facet the plot, default "TRUE".
+#' @param noSplit "logic", whether to split/facet the plot, default "TRUE".
#' @param nrow "num", rows to plot when noSplit = FALSE.
-#' @param relLength 'num', the corner axis line relative length to plot axis(0-1).
+#' @param relLength "num", the corner axis line relative length to plot axis(0-1).
#' @param relDist "num" ,the relative distance of corner axis label to axis.
#' @param axes "string", show multiple corner axis or only one (mul/one), default "mul".
#' @param legendPos "string", legend position same as ggplot theme function, default "right".
#' @param keySize The legned point size, default is 5.
#' @param lineTextcol "string", corner line and label color, default "black".
-#' @param stripCol "string", facet balckground color, default "white".
+#' @param stripCol "string", facet background color, default "white".
#' @param arrowType "string", arrow type (open/closed), default "closed".
#' @param cornerTextSize "num", the corner label text size, default is 3.
#' @param base_size "num", theme base size, default is 14.
-#' @param themebg Another theme style, default is 'default', or 'bwCorner'.
-#' @param addCircle Logic, whether add circle on clusters, default is 'FALSE'.
-#' @param cicAlpha "num", circle fill color alpha, default is 0.1,
+#' @param themebg Another theme style, default is "default", or "bwCorner".
+#' @param addCircle "logic", whether add circle on clusters, default is "FALSE".
+#' @param addCircle.legacy "logic", using the legacy version to add a circle, the parameters `nbin`, `nsm`, `addsm`, `sfac` and `qval` are only applicable to legacy, default is "FALSE".
+#' @param cicAlpha "num", circle fill color alpha, default is 0.1.
+#' @param cicDelta "num", the distance to extend the curve (circle), this parameter only takes effect when `addCircle.legacy = FALSE`.
#' @param cicLineSize "num", circle line size, default is 1.
-#' @param cicLineColor "num", circle line color, default is 'grey50'.
-#' @param cicLineLty "num", circle line type, default is 'dashed'.
+#' @param cicLineColor "num", circle line color, default is "grey50".
+#' @param cicLineLty "num", circle line type, default is "dashed".
#' @param nbin "num", number of points used to shape the hull, default 100.
#' @param nsm "num", number of points used to perform convolution, should less than nbin, default 10.
#' @param addsm "num", number of additional times of convolution performed, default 1.
@@ -33,8 +36,8 @@
#'
#' @param cellLabel Whether to label cell type on plot, default is FALSE.
#' @param cellLabelSize Cell type label size, default is 6.
-#' @param cellLabelColor Cell type label color, default is "balck".
-#' @param show.legend Wheher show legend, default is TRUE.
+#' @param cellLabelColor Cell type label color, default is "black".
+#' @param show.legend Whether show legend, default is TRUE.
#'
#' @return Return a ggplot object.
#' @export
@@ -85,46 +88,48 @@
#' relLength = 0.5
#' )
#'
-# define viriables
-globalVariables(c("x1", "y1", "linegrou", "angle", "lab",".data"))
+# define variables
+globalVariables(c("x1", "y1", "linegrou", "angle", "lab", ".data"))
# define function
-clusterCornerAxes <- function(object = NULL,
- reduction = "umap",
- groupFacet = groupFacet,
- clusterCol = "seurat_clusters",
- pSize = 1,
- aspect.ratio = NULL,
- noSplit = TRUE,
- nrow = 1,
- relLength = 0.25,
- relDist = 0.1,
- axes = "mul",
- show.legend = TRUE,
- legendPos = "right",
- keySize = 5,
- cellLabel = FALSE,
- cellLabelSize = 6,
- cellLabelColor = 'black',
- lineTextcol = "black",
- stripCol = "white",
- arrowType = "closed",
- cornerTextSize = 3,
- base_size = 14,
- themebg = "default",
- addCircle = FALSE,
- cicAlpha = 0.1,
- cicLineSize = 1,
- cicLineColor = 'grey50',
- cicLineLty = 'dashed',
- nbin = 100,
- nsm = 10,
- addsm = 1,
- qval = 1,
- sfac = 1.5) {
+clusterCornerAxes <- function(
+ object = NULL,
+ reduction = "umap",
+ groupFacet = groupFacet,
+ clusterCol = "seurat_clusters",
+ pSize = 1,
+ aspect.ratio = NULL,
+ noSplit = TRUE,
+ nrow = 1,
+ relLength = 0.25,
+ relDist = 0.1,
+ axes = "mul",
+ show.legend = TRUE,
+ legendPos = "right",
+ keySize = 5,
+ cellLabel = FALSE,
+ cellLabelSize = 6,
+ cellLabelColor = "black",
+ lineTextcol = "black",
+ stripCol = "white",
+ arrowType = "closed",
+ cornerTextSize = 3,
+ base_size = 14,
+ themebg = "default",
+ addCircle = FALSE,
+ addCircle.legacy = FALSE,
+ cicDelta,
+ cicAlpha = 0.1,
+ cicLineSize = 1,
+ cicLineColor = "grey50",
+ cicLineLty = "dashed",
+ nbin = 100,
+ nsm = 10,
+ addsm = 1,
+ qval = 1,
+ sfac = 1.5) {
# make PC data
- reduc <-
- data.frame(Seurat::Embeddings(object, reduction = reduction))
+ reduc <- data.frame(Seurat::Embeddings(object, reduction = reduction))
# metadata
meta <- object@meta.data
@@ -136,15 +141,17 @@ clusterCornerAxes <- function(object = NULL,
# text data
namePos <- pc12 %>%
dplyr::group_by(.data[[clusterCol]]) %>%
- dplyr::summarise(posMedia1 = stats::median(get(colnames(pc12)[1])),
- posMedia2 = stats::median(get(colnames(pc12)[2])))
+ dplyr::summarise(
+ posMedia1 = stats::median(get(colnames(pc12)[1])),
+ posMedia2 = stats::median(get(colnames(pc12)[2]))
+ )
#######################################
# data range
range <- floor(min(min(pc12[, 1]), min(pc12[, 2])))
- # get botomn-left coord
+ # get bottom-left coord
lower <- range - relDist * abs(range)
# label reldist to axes
@@ -157,9 +164,9 @@ clusterCornerAxes <- function(object = NULL,
mid <- abs(relLength * lower) / 2 + lower
# give reduction type
- if (startsWith(reduction,"umap")) {
+ if (startsWith(reduction, "umap")) {
axs_label <- paste("UMAP", 2:1, sep = "")
- } else if (startsWith(reduction,"tsne")) {
+ } else if (startsWith(reduction, "tsne")) {
axs_label <- paste("t-SNE", 2:1, sep = "")
} else {
print("Please give correct type(umap or tsne)!")
@@ -206,64 +213,90 @@ clusterCornerAxes <- function(object = NULL,
######################################################
# plot
- p <- ggplot2::ggplot(pc12,
- ggplot2::aes_string(x = colnames(pc12)[1], y = colnames(pc12)[2])) +
- ggplot2::geom_point(ggplot2::aes_string(color = clusterCol),
- size = pSize,
- show.legend = show.legend) +
+ p <- ggplot2::ggplot(
+ pc12,
+ ggplot2::aes_string(x = colnames(pc12)[1], y = colnames(pc12)[2])
+ ) +
+ ggplot2::geom_point(
+ ggplot2::aes_string(color = clusterCol),
+ size = pSize,
+ show.legend = show.legend
+ ) +
ggplot2::theme_classic(base_size = base_size) +
ggplot2::labs(x = "", y = "") +
- ggplot2::theme(strip.background = ggplot2::element_rect(colour = NA, fill = stripCol),
- aspect.ratio = aspect.ratio,
- legend.position = legendPos,
- plot.title = ggplot2::element_text(hjust = 0.5),
- axis.line = ggplot2::element_blank(),
- axis.ticks = ggplot2::element_blank(),
- axis.text = ggplot2::element_blank()) +
- ggplot2::geom_line(data = axes,
- ggplot2::aes(x = x1, y = y1, group = linegrou),
- color = lineTextcol,
- arrow = ggplot2::arrow(length = ggplot2::unit(0.1, "inches"),
- ends = "last",
- type = arrowType)) +
- ggplot2::geom_text(data = label,
- ggplot2::aes(x = x1,y = y1,angle = angle,label = lab),
- color = lineTextcol,
- fontface = "italic",
- size = cornerTextSize) +
+ ggplot2::theme(
+ strip.background = ggplot2::element_rect(colour = NA, fill = stripCol),
+ aspect.ratio = aspect.ratio,
+ legend.position = legendPos,
+ plot.title = ggplot2::element_text(hjust = 0.5),
+ axis.line = ggplot2::element_blank(),
+ axis.ticks = ggplot2::element_blank(),
+ axis.text = ggplot2::element_blank()
+ ) +
+ ggplot2::geom_line(
+ data = axes,
+ ggplot2::aes(x = x1, y = y1, group = linegrou),
+ color = lineTextcol,
+ arrow = ggplot2::arrow(
+ length = ggplot2::unit(0.1, "inches"),
+ ends = "last",
+ type = arrowType
+ )
+ ) +
+ ggplot2::geom_text(
+ data = label,
+ ggplot2::aes(x = x1, y = y1, angle = angle, label = lab),
+ color = lineTextcol,
+ fontface = "italic",
+ size = cornerTextSize
+ ) +
ggplot2::guides(color = ggplot2::guide_legend(override.aes = list(size = keySize)))
######################################################
# add text label
- if(cellLabel == FALSE){
+ if (cellLabel == FALSE) {
plabel <- p
- }else{
+ } else {
plabel <- p +
- ggrepel::geom_text_repel(data = namePos,
- ggplot2::aes_string(x = "posMedia1",y = "posMedia2",label = clusterCol),
- show.legend = F,
- size = cellLabelSize,
- color = cellLabelColor)
+ ggrepel::geom_text_repel(
+ data = namePos,
+ ggplot2::aes_string(x = "posMedia1", y = "posMedia2", label = clusterCol),
+ show.legend = FALSE,
+ size = cellLabelSize,
+ color = cellLabelColor
+ )
}
######################################################
# add circle line
- if(addCircle == FALSE){
+ if (addCircle == FALSE) {
p0 <- plabel
- # return(p0)
- }else{
+ } else if (addCircle.legacy) {
+ p0 <- plabel +
+ ggunchull::stat_unchull0(
+ ggplot2::aes_string(fill = clusterCol),
+ alpha = cicAlpha,
+ size = cicLineSize,
+ color = cicLineColor,
+ lty = cicLineLty,
+ show.legend = FALSE,
+ nbin = nbin,
+ nsm = nsm,
+ addsm = addsm,
+ sfac = sfac,
+ qval = qval
+ )
+ } else {
p0 <- plabel +
- ggunchull::stat_unchull0(ggplot2::aes_string(fill = clusterCol),
- alpha = cicAlpha,
- size = cicLineSize,
- color = cicLineColor,
- lty = cicLineLty,
- show.legend = F,
- nbin = nbin,
- nsm = nsm,
- addsm = addsm,
- sfac = sfac,
- qval = qval)
+ ggunchull::stat_unchull(
+ ggplot2::aes_string(fill = clusterCol),
+ alpha = cicAlpha,
+ size = cicLineSize,
+ color = cicLineColor,
+ lty = cicLineLty,
+ show.legend = FALSE,
+ delta = cicDelta
+ )
}
######################################################
@@ -279,11 +312,13 @@ clusterCornerAxes <- function(object = NULL,
if (themebg == "bwCorner") {
p2 <- p1 +
ggplot2::theme_bw(base_size = base_size) +
- ggplot2::theme(panel.grid = ggplot2::element_blank(),
- axis.text = ggplot2::element_blank(),
- axis.ticks = ggplot2::element_blank(),
- aspect.ratio = 1,
- strip.background = ggplot2::element_rect(colour = NA, fill = stripCol))
+ ggplot2::theme(
+ panel.grid = ggplot2::element_blank(),
+ axis.text = ggplot2::element_blank(),
+ axis.ticks = ggplot2::element_blank(),
+ aspect.ratio = 1,
+ strip.background = ggplot2::element_rect(colour = NA, fill = stripCol)
+ )
} else if (themebg == "default") {
p2 <- p1
}
diff --git a/R/drawLegend.R b/R/drawLegend.R
index b93c3db..46d8330 100644
--- a/R/drawLegend.R
+++ b/R/drawLegend.R
@@ -14,63 +14,74 @@
#' @return combine plot
#' @export
-globalVariables(c("x","y"))
+globalVariables(c("x", "y"))
-drawLegend <- function(object = NULL,
- plot = NULL,
- cellType = NULL,
- clusters = NULL,
- ncol = 1,
- col = NULL,
- pt.size = 8,
- text.size = 4){
+drawLegend <- function(
+ object = NULL,
+ plot = NULL,
+ cellType = NULL,
+ clusters = NULL,
+ ncol = 1,
+ col = NULL,
+ pt.size = 8,
+ text.size = 4) {
# prepare data
leg.data <- object@meta.data %>%
- dplyr::select(.data[[cellType]],.data[[clusters]]) %>%
+ dplyr::select(.data[[cellType]], .data[[clusters]]) %>%
unique()
- colnames(leg.data) <- c("cellType","clusters")
+ colnames(leg.data) <- c("cellType", "clusters")
# reorder
- leg.data <- leg.data[match(levels(leg.data$cellType),leg.data$cellType),]
+ leg.data <- leg.data[match(levels(leg.data$cellType), leg.data$cellType), ]
# add xy position
- if(ncol > 1){
- leg.data$x <- rep(1:ncol,c(ceiling(nrow(leg.data)/ncol),
- nrow(leg.data) - ceiling(nrow(leg.data)/ncol)))
+ if (ncol > 1) {
+ leg.data$x <- rep(
+ 1:ncol,
+ c(
+ ceiling(nrow(leg.data) / ncol),
+ nrow(leg.data) - ceiling(nrow(leg.data) / ncol)
+ )
+ )
- leg.data$y <- c(1:ceiling(nrow(leg.data)/ncol),
- 1:(nrow(leg.data) - ceiling(nrow(leg.data)/ncol)))
- }else{
+ leg.data$y <- c(
+ 1:ceiling(nrow(leg.data) / ncol),
+ 1:(nrow(leg.data) - ceiling(nrow(leg.data) / ncol))
+ )
+ } else {
leg.data$x <- 1
- leg.data$y <- 1:nrow(leg.data)
+ leg.data$y <- seq_len(nrow(leg.data))
}
# order
- leg.data$cellType <- factor(leg.data$cellType,levels = rev(levels(leg.data$cellType)))
+ leg.data$cellType <- factor(leg.data$cellType, levels = rev(levels(leg.data$cellType)))
# plot
- if(is.null(col)){
+ if (is.null(col)) {
color <- rev(scales::hue_pal()(nrow(leg.data)))
- }else{
+ } else {
color <- rev(col)
}
- pleg <-
- ggplot2::ggplot(leg.data,ggplot2::aes(x = x,y = y)) +
- ggplot2::geom_point(ggplot2::aes(color = cellType),
- show.legend = F,
- size = pt.size) +
+ pleg <- ggplot2::ggplot(leg.data, ggplot2::aes(x = x, y = y)) +
+ ggplot2::geom_point(
+ ggplot2::aes(color = cellType),
+ show.legend = FALSE,
+ size = pt.size
+ ) +
ggplot2::geom_text(ggplot2::aes(label = clusters)) +
- ggplot2::geom_text(ggplot2::aes(label = cellType),
- hjust = 0,
- nudge_x = 0.2,
- size = text.size) +
+ ggplot2::geom_text(
+ ggplot2::aes(label = cellType),
+ hjust = 0,
+ nudge_x = 0.2,
+ size = text.size
+ ) +
ggplot2::scale_color_manual(values = color) +
ggplot2::scale_y_reverse() +
- ggplot2::xlim(0,ncol + 1) +
+ ggplot2::xlim(0, ncol + 1) +
ggplot2::theme_void()
# COMBINE
- cowplot::plot_grid(plot,pleg)
+ cowplot::plot_grid(plot, pleg)
}
diff --git a/R/featureCornerAxes.R b/R/featureCornerAxes.R
new file mode 100644
index 0000000..34fa17f
--- /dev/null
+++ b/R/featureCornerAxes.R
@@ -0,0 +1,286 @@
+#' @name featureCornerAxes
+#' @author Junjun Lao
+#' @title Add corner axes on seurat UMAP/tSNE gene FeaturePlot function figures
+#'
+#' @param object object seurat object.
+#' @param reduction "string", reduction type (umap/tsne).
+#' @param features "string", the gene you want to plot.
+#' @param groupFacet "string", give the column name in seurat metadata to facet plot, if it is "NULL", facet plot only by gene.
+#' @param relLength "num", the corner axis line relative length to plot axis(0-1).
+#' @param relDist "num", the relative distance of corner axis label to axis.
+#' @param aspect.ratio "num", plot width and height ratio, default NULL.
+#' @param low "string", point color with low expression.
+#' @param high "string", point color with high expression.
+#' @param axes "string", show multiple corner axis or only one (mul/one), default "mul".
+#' @param legendPos "string", legend position same as ggplot theme function, default "right".
+#' @param stripCol "string", facet background color, defaults "white".
+#' @param pSize "num", point size.
+#' @param arrowType "string", arrow type (open/closed), default "closed".
+#' @param lineTextcol "string", facet background color, default "white".
+#' @param cornerTextSize "num", the corner label text size, default is 5.
+#' @param base_size "num", theme base size, default is 14.
+#' @param themebg Another theme style, default is "default", or "bwCorner".
+#' @param show.legend Whether show legend, default "TRUE".
+#' @param cornerVariable Which group corner axis to be added when "axes" set to "one", default is the first group.
+#' @param nLayout = NULL Similar to the ncol/nrow for the layout, default is the gene numbers.
+#' @param minExp Minimum expression value defined, default is NULL.
+#' @param maxExp Maxmum expression value defined, default is NULL.
+#' @return Return a ggplot.
+#' @export
+#' @examples
+#'
+#' test <- system.file("extdata", "seuratTest.RDS", package = "scRNAtoolVis")
+#'
+#' tmp <- readRDS(test)
+#'
+#' # umap
+#' featureCornerAxes(
+#' object = tmp, reduction = "umap",
+#' groupFacet = "orig.ident",
+#' relLength = 0.5, relDist = 0.2,
+#' features = c("Actb", "Ythdc1", "Ythdf2")
+#' )
+#'
+#' # one axes
+#' featureCornerAxes(
+#' object = tmp, reduction = "umap",
+#' groupFacet = "orig.ident",
+#' features = c("Actb", "Ythdc1", "Ythdf2"),
+#' relLength = 0.5, relDist = 0.2,
+#' axes = "one",
+#' lineTextcol = "grey50"
+#' )
+#'
+#' # tsne
+#' featureCornerAxes(
+#' object = tmp, reduction = "tsne",
+#' groupFacet = "orig.ident",
+#' relLength = 0.5, relDist = 0.2,
+#' features = c("Actb", "Ythdc1", "Ythdf2")
+#' )
+#'
+#'
+# define variables
+globalVariables(c("x1", "y1", "linegrou", "angle", "lab", "gene_name", "scaledValue"))
+
+# define function
+featureCornerAxes <- function(
+ object = NULL,
+ reduction = "umap",
+ features = NULL,
+ groupFacet = "orig.ident",
+ minExp = NULL,
+ maxExp = NULL,
+ relLength = 0.25,
+ relDist = 0.1,
+ aspect.ratio = NULL,
+ low = "lightgrey",
+ high = "red",
+ axes = "mul",
+ show.legend = TRUE,
+ legendPos = "right",
+ stripCol = "white",
+ cornerVariable = NULL,
+ nLayout = NULL,
+ pSize = 1,
+ arrowType = "closed",
+ lineTextcol = "black",
+ cornerTextSize = 3,
+ base_size = 14,
+ themebg = "default") {
+ # make PC data
+ reduc <- data.frame(Seurat::Embeddings(object, reduction = reduction))
+
+ # metadata
+ meta <- object@meta.data
+
+ # combine
+ pc12 <- cbind(reduc, meta)
+
+ # get gene expression
+ geneExp <- Seurat::FetchData(object = object, vars = features)
+
+ # cbind
+ mer <- cbind(pc12, geneExp)
+
+ # merge data
+ megredf <- reshape2::melt(
+ mer,
+ id.vars = colnames(pc12),
+ variable.name = "gene_name",
+ value.name = "scaledValue"
+ )
+
+ # data range
+ range <- floor(min(min(pc12[, 1]), min(pc12[, 2])))
+
+ # get bottom-left coord
+ lower <- range - relDist * abs(range)
+
+ # label reldist to axes
+ labelRel <- relDist * abs(lower)
+
+ # get relative line length
+ linelen <- abs(relLength * lower) + lower
+
+ # mid point
+ mid <- abs(relLength * lower) / 2 + lower
+
+ # give reduction type
+ if (startsWith(reduction, "umap")) {
+ axs_label <- paste("UMAP", 2:1, sep = "")
+ } else if (startsWith(reduction, "tsne")) {
+ axs_label <- paste("t-SNE", 2:1, sep = "")
+ } else {
+ print("Please give correct type(umap or tsne)!")
+ }
+
+ if (axes == "mul") {
+ # axises data
+ axes <- data.frame(
+ "x1" = c(lower, lower, lower, linelen),
+ "y1" = c(lower, linelen, lower, lower),
+ "linegrou" = c(1, 1, 2, 2)
+ )
+ # axises label
+ label <- data.frame(
+ "lab" = c(axs_label),
+ "angle" = c(90, 0),
+ "x1" = c(lower - labelRel, mid),
+ "y1" = c(mid, lower - labelRel)
+ )
+ } else if (axes == "one") {
+ # add specific group corner
+ if (is.null(cornerVariable)) {
+ lev <- levels(pc12[, groupFacet])
+ if (!is.null(lev)) {
+ firstFacet <- factor(lev[1], levels = lev)
+ } else {
+ firstFacet <- unique(pc12[, groupFacet])[1]
+ }
+ } else {
+ lev <- levels(pc12[, groupFacet])
+ if (!is.null(lev)) {
+ firstFacet <- factor(cornerVariable, levels = lev)
+ } else {
+ firstFacet <- cornerVariable
+ }
+ }
+
+ # axises data
+ axes <- data.frame(
+ "x1" = c(lower, lower, lower, linelen),
+ "y1" = c(lower, linelen, lower, lower),
+ "linegrou" = c(1, 1, 2, 2),
+ "group" = rep(firstFacet, 2)
+ )
+ # axises label
+ label <- data.frame(
+ "lab" = c(axs_label),
+ angle = c(90, 0),
+ "x1" = c(lower - labelRel, mid),
+ "y1" = c(mid, lower - labelRel),
+ "group" = rep(firstFacet, 2)
+ )
+
+ # rename group name
+ colnames(axes)[4] <- groupFacet
+ colnames(label)[5] <- groupFacet
+ } else {
+ print("Please give correct args(mul or one)!")
+ }
+
+ ####################################
+ # set color value range
+ if (is.null(minExp) && is.null(maxExp)) {
+ minexp <- 0
+ maxexp <- round(max(megredf$scaledValue) + 1, digits = 0)
+ } else {
+ minexp <- minExp
+ maxexp <- maxExp
+ }
+
+ ####################################################
+ # plot
+ pmain <- ggplot2::ggplot(
+ megredf,
+ ggplot2::aes(x = megredf[, 1], y = megredf[, 2])
+ ) +
+ ggplot2::geom_point(
+ ggplot2::aes(color = scaledValue),
+ size = pSize,
+ show.legend = show.legend
+ ) +
+ ggplot2::theme_classic(base_size = base_size) +
+ ggplot2::scale_color_gradient(
+ name = "", low = low, high = high,
+ limits = c(minexp, maxexp),
+ na.value = high
+ ) +
+ ggplot2::labs(x = "", y = "") +
+ ggplot2::geom_line(
+ data = axes,
+ ggplot2::aes(x = x1, y = y1, group = linegrou),
+ color = lineTextcol,
+ arrow = ggplot2::arrow(
+ length = ggplot2::unit(0.1, "inches"),
+ ends = "last",
+ type = arrowType
+ )
+ ) +
+ ggplot2::geom_text(
+ data = label,
+ ggplot2::aes(x = x1, y = y1, angle = angle, label = lab),
+ fontface = "italic",
+ color = lineTextcol,
+ size = cornerTextSize
+ ) +
+ ggplot2::theme(
+ strip.background = ggplot2::element_rect(colour = NA, fill = stripCol),
+ strip.text = ggplot2::element_text(size = base_size),
+ strip.text.y = ggplot2::element_text(angle = 0),
+ aspect.ratio = aspect.ratio,
+ legend.position = legendPos,
+ plot.title = ggplot2::element_text(hjust = 0.5),
+ axis.line = ggplot2::element_blank(),
+ axis.ticks = ggplot2::element_blank(),
+ axis.text = ggplot2::element_blank()
+ )
+
+ ######################################
+ # plot layout
+ if (is.null(nLayout)) {
+ nLayout <- length(features)
+ } else {
+ nLayout <- nLayout
+ }
+
+ ######################################
+ # facet plot
+ if (is.null(groupFacet)) {
+ p1 <- pmain +
+ ggplot2::facet_wrap(facets = "gene_name", ncol = nLayout)
+ } else {
+ p1 <- pmain +
+ ggplot2::facet_grid(facets = c("gene_name", groupFacet))
+ }
+
+ ######################################
+ # theme style
+ if (themebg == "bwCorner") {
+ p2 <- p1 +
+ ggplot2::theme_bw(base_size = base_size) +
+ ggplot2::theme(
+ panel.grid = ggplot2::element_blank(),
+ axis.text = ggplot2::element_blank(),
+ axis.ticks = ggplot2::element_blank(),
+ aspect.ratio = 1,
+ strip.background = ggplot2::element_rect(colour = NA, fill = stripCol)
+ )
+ } else if (themebg == "default") {
+ p2 <- p1
+ }
+
+ # output
+ return(p2)
+}
diff --git a/R/featurePlot.R b/R/featurePlot.R
index 714cb5e..17e242c 100644
--- a/R/featurePlot.R
+++ b/R/featurePlot.R
@@ -1,10 +1,7 @@
-globalVariables(c("col_rg","tmp_col"))
-#' featurePlot Function
-#'
-#' This function creates a scatter plot for multiple genes or features from a
-#' Seurat object.
-#'
+#' @name featurePlot
#' @author Jun Zhang
+#' @title This function creates a scatter plot for multiple genes or features from a
+#' Seurat object.
#'
#' @param object A Seurat object containing the data.
#' @param dim The dimension to use for plotting, default is "umap".
@@ -38,7 +35,7 @@ globalVariables(c("col_rg","tmp_col"))
#'
#' @examples
#' \dontrun{
-#' # Assuming 'seurat_obj' is a Seurat object
+#' # Assuming "seurat_obj" is a Seurat object
#' featurePlot(object = seurat_obj, genes = c("gene1", "gene2", "gene3"), nrow = 2, ncol = 2)
#' }
#'
@@ -51,26 +48,31 @@ globalVariables(c("col_rg","tmp_col"))
#' @importFrom stats quantile
#'
#' @export
-featurePlot <- function(object = NULL,
- dim = "umap",
- genes = NULL,
- nrow = NULL,
- ncol = NULL,
- quantile.val = 1,
- color = NULL,
- rm.axis = FALSE,
- rm.legend = FALSE,
- add.rect = FALSE,
- add.corArrow = FALSE,
- add.strip = FALSE,
- corLabel.dist = 0.08,
- arrow.len = 0.2,
- arrow.label.size = 6,
- plot.size = 0.6,
- keep.oneCor = FALSE,
- xlab = NULL,ylab = NULL,
- respect = TRUE,
- point.size = 1){
+
+globalVariables(c("col_rg", "tmp_col"))
+
+featurePlot <- function(
+ object = NULL,
+ dim = "umap",
+ genes = NULL,
+ nrow = NULL,
+ ncol = NULL,
+ quantile.val = 1,
+ color = NULL,
+ rm.axis = FALSE,
+ rm.legend = FALSE,
+ add.rect = FALSE,
+ add.corArrow = FALSE,
+ add.strip = FALSE,
+ corLabel.dist = 0.08,
+ arrow.len = 0.2,
+ arrow.label.size = 6,
+ plot.size = 0.6,
+ keep.oneCor = FALSE,
+ xlab = NULL,
+ ylab = NULL,
+ respect = TRUE,
+ point.size = 1) {
# ============================================================================
# 1_extract data
# ============================================================================
@@ -99,110 +101,144 @@ featurePlot <- function(object = NULL,
ncol <- ifelse(is.null(nrow), length(genes), ceiling(length(genes) / nrow))
}
- gene_mtx <- suppressWarnings(matrix(genes,nrow = nrow,ncol = ncol))
+ gene_mtx <- suppressWarnings(matrix(genes, nrow = nrow, ncol = ncol))
# assign colors
- if(is.null(color)){
- cols <- c("grey90", "#57C5B6", "#159895","#1A5F7A","#002B5B")
- }else{
+ if (is.null(color)) {
+ cols <- c("grey90", "#57C5B6", "#159895", "#1A5F7A", "#002B5B")
+ } else {
cols <- color
}
# ============================================================================
# 2_draw plot
# ============================================================================
- if(rm.axis == FALSE){
- lab.shift = unit(-2.5,"lines")
- }else{
- lab.shift = unit(-1,"lines")
+ if (rm.axis == FALSE) {
+ lab.shift <- unit(-2.5, "lines")
+ } else {
+ lab.shift <- unit(-1, "lines")
}
# CANVAS FOR PLOT
grid.newpage()
- pushViewport(viewport(x = 0.5,y = 0.5,
- width = 0.9,height = 0.9,
- xscale = range(mer[,1]),yscale = range(mer[,2]),
- layout = grid.layout(nrow = nrow,ncol = ncol,respect = respect)
- ))
+ pushViewport(
+ viewport(
+ x = 0.5, y = 0.5,
+ width = 0.9, height = 0.9,
+ xscale = range(mer[, 1]), yscale = range(mer[, 2]),
+ layout = grid.layout(nrow = nrow, ncol = ncol, respect = respect)
+ )
+ )
# loop
for (i in 1:nrow) {
for (j in 1:ncol) {
# check genes numbers
- if(i*j > length(genes)){
+ if (i * j > length(genes)) {
break
}
# ===========================================================
# 1_panel grid
- pushViewport(viewport(layout.pos.row = i,layout.pos.col = j))
- if(add.rect == TRUE){
+ pushViewport(
+ viewport(layout.pos.row = i, layout.pos.col = j)
+ )
+
+ if (add.rect == TRUE) {
grid.rect()
}
# process data
- quantile_val <- quantile(mer[,gene_mtx[i,j]],probs = quantile.val)
- mer <- mer |> dplyr::mutate(tmp_col = if_else(.data[[gene_mtx[i,j]]] > quantile_val,
- quantile_val,
- .data[[gene_mtx[i,j]]]))
+ quantile_val <- quantile(mer[, gene_mtx[i, j]], probs = quantile.val)
+ mer <- mer |>
+ dplyr::mutate(tmp_col = if_else(.data[[gene_mtx[i, j]]] > quantile_val,
+ quantile_val,
+ .data[[gene_mtx[i, j]]]
+ ))
- tmp_data <- mer |> dplyr::arrange(tmp_col)
+ tmp_data <- mer |>
+ dplyr::arrange(tmp_col)
col_p <- colorRampPalette(cols)(100)
- cut_range <- cut(tmp_data[,"tmp_col"],100)
+ cut_range <- cut(tmp_data[, "tmp_col"], 100)
labs <- levels(cut_range)
names(labs) <- col_p
- tmp_data <- tmp_data |> dplyr::mutate(col_rg = as.character(cut_range)) |>
- dplyr::mutate(col_f = ifelse(col_rg %in% labs,names(labs)[match(col_rg,labs)],"black"))
+ tmp_data <- tmp_data |>
+ dplyr::mutate(col_rg = as.character(cut_range)) |>
+ dplyr::mutate(col_f = ifelse(col_rg %in% labs, names(labs)[match(col_rg, labs)], "black"))
# ===========================================================
# 2_scatter plot
- pushViewport(viewport(x = 0.5,y = 0.5,width = plot.size,height = plot.size,
- xscale = extendrange(range(tmp_data[,1]),f = 0.05),
- yscale = extendrange(range(tmp_data[,2]),f = 0.05)))
+ pushViewport(
+ viewport(
+ x = 0.5, y = 0.5, width = plot.size, height = plot.size,
+ xscale = extendrange(range(tmp_data[, 1]), f = 0.05),
+ yscale = extendrange(range(tmp_data[, 2]), f = 0.05)
+ )
+ )
# whether add corner arrows
- if(keep.oneCor == TRUE){
- if(j == 1){
- if(add.corArrow == TRUE){
- grid.segments(x0 = 0,x1 = arrow.len,y0 = 0,y1 = 0,
- arrow = arrow(length = unit(2,"mm"),type = "closed"),
- gp = gpar(fill = "black"))
- grid.text(label = paste0(toupper(dim)," 1"),x = arrow.len/2,y = -corLabel.dist,
- gp = gpar(fontsize = arrow.label.size,fontface = "bold.italic"))
- grid.segments(x0 = 0,x1 = 0,y0 = 0,y1 = arrow.len,
- arrow = arrow(length = unit(2,"mm"),type = "closed"),
- gp = gpar(fill = "black"))
- grid.text(label = paste0(toupper(dim)," 2"),x = -corLabel.dist,y = arrow.len/2,rot = 90,gp =
- gpar(fontsize = arrow.label.size,fontface = "bold.italic"))
- }else{
+ if (keep.oneCor == TRUE) {
+ if (j == 1) {
+ if (add.corArrow == TRUE) {
+ grid.segments(
+ x0 = 0, x1 = arrow.len, y0 = 0, y1 = 0,
+ arrow = arrow(length = unit(2, "mm"), type = "closed"),
+ gp = gpar(fill = "black")
+ )
+ grid.text(
+ label = paste0(toupper(dim), " 1"), x = arrow.len / 2, y = -corLabel.dist,
+ gp = gpar(fontsize = arrow.label.size, fontface = "bold.italic")
+ )
+ grid.segments(
+ x0 = 0, x1 = 0, y0 = 0, y1 = arrow.len,
+ arrow = arrow(length = unit(2, "mm"), type = "closed"),
+ gp = gpar(fill = "black")
+ )
+ grid.text(
+ label = paste0(toupper(dim), " 2"),
+ x = -corLabel.dist, y = arrow.len / 2, rot = 90,
+ gp = gpar(fontsize = arrow.label.size, fontface = "bold.italic")
+ )
+ } else {
grid.rect()
}
}
- }else{
- if(add.corArrow == TRUE){
- grid.segments(x0 = 0,x1 = arrow.len,y0 = 0,y1 = 0,
- arrow = arrow(length = unit(2,"mm"),type = "closed"),
- gp = gpar(fill = "black"))
- grid.text(label = paste0(toupper(dim)," 1"),x = arrow.len/2,y = -corLabel.dist,
- gp = gpar(fontsize = arrow.label.size,fontface = "bold.italic"))
- grid.segments(x0 = 0,x1 = 0,y0 = 0,y1 = arrow.len,
- arrow = arrow(length = unit(2,"mm"),type = "closed"),
- gp = gpar(fill = "black"))
- grid.text(label = paste0(toupper(dim)," 2"),x = -corLabel.dist,y = arrow.len/2,rot = 90,gp =
- gpar(fontsize = arrow.label.size,fontface = "bold.italic"))
- }else{
+ } else {
+ if (add.corArrow == TRUE) {
+ grid.segments(
+ x0 = 0, x1 = arrow.len, y0 = 0, y1 = 0,
+ arrow = arrow(length = unit(2, "mm"), type = "closed"),
+ gp = gpar(fill = "black")
+ )
+ grid.text(
+ label = paste0(toupper(dim), " 1"), x = arrow.len / 2, y = -corLabel.dist,
+ gp = gpar(fontsize = arrow.label.size, fontface = "bold.italic")
+ )
+ grid.segments(
+ x0 = 0, x1 = 0, y0 = 0, y1 = arrow.len,
+ arrow = arrow(length = unit(2, "mm"), type = "closed"),
+ gp = gpar(fill = "black")
+ )
+ grid.text(
+ label = paste0(toupper(dim), " 2"),
+ x = -corLabel.dist, y = arrow.len / 2, rot = 90,
+ gp = gpar(fontsize = arrow.label.size, fontface = "bold.italic")
+ )
+ } else {
grid.rect()
}
}
- grid.points(x = tmp_data[,1],y = tmp_data[,2],pch = 19,size = unit(point.size,"pt"),
- gp = gpar(col = tmp_data$col_f))
+ grid.points(
+ x = tmp_data[, 1], y = tmp_data[, 2], pch = 19, size = unit(point.size, "pt"),
+ gp = gpar(col = tmp_data$col_f)
+ )
# whether draw axis
- if(add.corArrow == FALSE){
- if(rm.axis == FALSE){
+ if (add.corArrow == FALSE) {
+ if (rm.axis == FALSE) {
# grid.xaxis()
# grid.yaxis()
jjPlot::grid.xaxis2(label.space = 0.5)
@@ -211,48 +247,59 @@ featurePlot <- function(object = NULL,
}
# add strip
- if(add.strip == TRUE){
- grid.rect(x = 0.5,y = 1,width = 1,height = 0.15,gp = gpar(fill = "grey85"),
- just = "bottom")
+ if (add.strip == TRUE) {
+ grid.rect(
+ x = 0.5, y = 1, width = 1,
+ height = 0.15, gp = gpar(fill = "grey85"),
+ just = "bottom"
+ )
}
- grid.text(label = gene_mtx[i,j],x = 0.5,y = unit(1 + 0.15/2,"npc"),
- gp = gpar(fontface = "bold.italic"))
- if(add.corArrow == FALSE){
+ grid.text(
+ label = gene_mtx[i, j], x = 0.5, y = unit(1 + 0.15 / 2, "npc"),
+ gp = gpar(fontface = "bold.italic")
+ )
+ if (add.corArrow == FALSE) {
# axis labels
- if(!is.null(xlab) || !is.null(ylab)){
- axis.label.x = xlab
- axis.label.y = ylab
- }else{
- axis.label.x = paste0(toupper(dim)," dimension 1")
- axis.label.y = paste0(toupper(dim)," dimension 2")
+ if (!is.null(xlab) || !is.null(ylab)) {
+ axis.label.x <- xlab
+ axis.label.y <- ylab
+ } else {
+ axis.label.x <- paste0(toupper(dim), " dimension 1")
+ axis.label.y <- paste0(toupper(dim), " dimension 2")
}
- grid.text(label = axis.label.x,x = 0.5,y = lab.shift)
- grid.text(label = axis.label.y,x = lab.shift,y = 0.5,rot = 90)
+ grid.text(label = axis.label.x, x = 0.5, y = lab.shift)
+ grid.text(label = axis.label.y, x = lab.shift, y = 0.5, rot = 90)
}
popViewport()
# ===========================================================
# 3_draw legend
- if(rm.legend == FALSE){
- pushViewport(viewport(x = 0.5 + plot.size/2 + 0.01,y = 0.5,
- width = 0.025,height = unit(plot.size, "npc"),
- just = "left",
- yscale = range(tmp_data[,gene_mtx[i,j]])))
+ if (rm.legend == FALSE) {
+ pushViewport(
+ viewport(
+ x = 0.5 + plot.size / 2 + 0.01, y = 0.5,
+ width = 0.025, height = unit(plot.size, "npc"),
+ just = "left",
+ yscale = range(tmp_data[, gene_mtx[i, j]])
+ )
+ )
# grid.rect(x = 0.5, y = unit(seq(0.25,0.75, length = 100), "npc"),
# width = unit(1, "npc"), height = unit(0.5, "npc"),
# just = "centre",default.units = "npc",
# gp = gpar(col = NA, fill = col_p))
# grid.rect(gp = gpar(fill = NA))
- # # grid.yaxis(main = F)
+ # # grid.yaxis(main = FALSE)
# jjPlot::grid.yaxis2(side = "right",tick.len = 0.25)
- jjPlot::grid.colorkey(x = tmp_data[,gene_mtx[i,j]],
- color = cols,
- pos = "v",
- ticks.side = "right")
+ jjPlot::grid.colorkey(
+ x = tmp_data[, gene_mtx[i, j]],
+ color = cols,
+ pos = "v",
+ ticks.side = "right"
+ )
popViewport()
}
diff --git a/R/jjDotPlot.R b/R/jjDotPlot.R
index 16bdf48..a76d4c5 100644
--- a/R/jjDotPlot.R
+++ b/R/jjDotPlot.R
@@ -8,8 +8,8 @@
#' @param id the cell clusters id in the metadata info, default "seurat_clusters".
#' @param split.by the group name to split, default NULL.
#' @param split.by.aesGroup whether the dot color filled by group, default FALSE.
-#' @param gene the genes to be drawed in plot, default NULL.
-#' @param markerGene the marker genes with celltype info to be drawed, default NULL.
+#' @param gene the genes to be drawn in plot, default NULL.
+#' @param markerGene the marker genes with celltype info to be drawn, default NULL.
#' @param point.geom the ggplot "point" geom layer to be shown, default TRUE.
#' @param point.shape the point shape,default 21.
#' @param tile.geom the ggplot "tile" geom layer to be shown, default FALSE.
@@ -43,7 +43,7 @@
#' @param hjust annoSegment text hjust, default 0.
#' @param legend.position ggplot legend position, default "right".
#' @param bar.legendTitle colorbar legend title, default "Mean expression in group".
-#' @param point.lengdTitle point size legend title, default "Fraction of cells in group (%)".
+#' @param point.legendTitle point size legend title, default "Fraction of cells in group (%)".
#' @param ... other parameters passed to annoSegment function.
#'
#' @param gene.order supply your own gene orders, default NULL.
@@ -64,7 +64,7 @@
#' pbmc <- readRDS(httest)
#'
#' # add groups
-#' pbmc$groups <- rep(c('stim','control'),each = 1319)
+#' pbmc$groups <- rep(c("stim", "control"), each = 1319)
#' # add celltype
#' pbmc$celltype <- Seurat::Idents(pbmc)
#'
@@ -72,112 +72,127 @@
#' markergene <- data("top3pbmc.markers")
#'
#' # ====================================
-#' jjDotPlot(object = pbmc,
-#' gene = top3pbmc.markers$gene)
+#' jjDotPlot(
+#' object = pbmc,
+#' gene = top3pbmc.markers$gene
+#' )
#'
-#' jjDotPlot(object = pbmc,
-#' gene = top3pbmc.markers$gene,
-#' id = 'celltype')
+#' jjDotPlot(
+#' object = pbmc,
+#' gene = top3pbmc.markers$gene,
+#' id = "celltype"
+#' )
#'
-#' jjDotPlot(object = pbmc,
-#' markerGene = top3pbmc.markers)
+#' jjDotPlot(
+#' object = pbmc,
+#' markerGene = top3pbmc.markers
+#' )
#'
-#' jjDotPlot(object = pbmc,
-#' markerGene = top3pbmc.markers,
-#' xtree = TRUE)
+#' jjDotPlot(
+#' object = pbmc,
+#' markerGene = top3pbmc.markers,
+#' xtree = TRUE
+#' )
#'
-#' jjDotPlot(object = pbmc,
-#' markerGene = top3pbmc.markers,
-#' anno = TRUE,
-#' plot.margin = c(3,1,1,1))
-#' }
-
-globalVariables(c("%||%",".","avg.exp", "avg.exp.scaled", "celltype", "group", "pct.exp", "unit"))
-
+#' jjDotPlot(
+#' object = pbmc,
+#' markerGene = top3pbmc.markers,
+#' anno = TRUE,
+#' plot.margin = c(3, 1, 1, 1)
+#' )
+#' }
+globalVariables(c("%||%", ".", "avg.exp", "avg.exp.scaled", "celltype", "group", "pct.exp", "unit"))
PercentAbove <- utils::getFromNamespace("PercentAbove", "Seurat")
# define function
-jjDotPlot <- function(object = NULL,
- assay = NULL,
- slot = "data",
- id = "seurat_clusters",
- split.by = NULL,
- split.by.aesGroup = FALSE,
- gene = NULL,
- markerGene = NULL,
- gene.order = NULL,
- cluster.order = NULL,
- point.geom = TRUE,
- point.shape = 21,
- tile.geom = FALSE,
- dot.col = c("white","#990000"),
- midpoint = 0.5,
- scale = TRUE,
- col.min = -2.5,
- col.max = 2.5,
- rescale = FALSE,
- rescale.min = 0,
- rescale.max = 1,
- dot.min = 1,
- dot.max = 6,
- base_size = 14,
- x.text.angle = 90,
- x.text.hjust = 1,
- x.text.vjust = 0,
- ytree = TRUE,
- xtree = FALSE,
- tree.pos = NULL,
- same.pos.label = FALSE,
- size.width = 0.3,
- bar.width = 4.5,
- plot.margin = c(1,1,1,1),
- anno = FALSE,
- aesGroName = 'cluster',
- segWidth = 0.8,
- lwd = 3,
- textRot = 90,
- textSize = 14,
- hjust = 0,
- legend.position = 'right',
- bar.legendTitle = "Mean expression \n in group",
- point.lengdTitle = "Fraction of cells \n in group (%)",
- ...){
+jjDotPlot <- function(
+ object = NULL,
+ assay = NULL,
+ slot = "data",
+ id = "seurat_clusters",
+ split.by = NULL,
+ split.by.aesGroup = FALSE,
+ gene = NULL,
+ markerGene = NULL,
+ gene.order = NULL,
+ cluster.order = NULL,
+ point.geom = TRUE,
+ point.shape = 21,
+ tile.geom = FALSE,
+ dot.col = c("white", "#990000"),
+ midpoint = 0.5,
+ scale = TRUE,
+ col.min = -2.5,
+ col.max = 2.5,
+ rescale = FALSE,
+ rescale.min = 0,
+ rescale.max = 1,
+ dot.min = 1,
+ dot.max = 6,
+ base_size = 14,
+ x.text.angle = 90,
+ x.text.hjust = 1,
+ x.text.vjust = 0,
+ ytree = TRUE,
+ xtree = FALSE,
+ tree.pos = NULL,
+ same.pos.label = FALSE,
+ size.width = 0.3,
+ bar.width = 4.5,
+ plot.margin = c(1, 1, 1, 1),
+ anno = FALSE,
+ aesGroName = "cluster",
+ segWidth = 0.8,
+ lwd = 3,
+ textRot = 90,
+ textSize = 14,
+ hjust = 0,
+ legend.position = "right",
+ bar.legendTitle = "Mean expression \n in group",
+ point.legendTitle = "Fraction of cells \n in group (%)",
+ ...) {
# set assays
assay <- assay %||% Seurat::DefaultAssay(object = object)
Seurat::DefaultAssay(object = object) <- assay
# get gene expression
- if(is.null(gene) & !is.null(markerGene)){
- geneExp <- Seurat::FetchData(object = object,
- vars = unique(markerGene$gene),
- slot = slot)
- }else if(!is.null(gene) & is.null(markerGene)){
- geneExp <- Seurat::FetchData(object = object,
- vars = gene,
- slot = slot)
- }else{
- print('Please supply one option!')
+ if (is.null(gene) && !is.null(markerGene)) {
+ geneExp <- Seurat::FetchData(
+ object = object,
+ vars = unique(markerGene$gene),
+ slot = slot
+ )
+ } else if (!is.null(gene) && is.null(markerGene)) {
+ geneExp <- Seurat::FetchData(
+ object = object,
+ vars = gene,
+ slot = slot
+ )
+ } else {
+ print("Please supply one option!")
}
- # get cluster number or celtype
+ # get cluster number or celltype
# whether split by groups
- if(is.null(split.by)){
- if(id %in% colnames(object@meta.data)){
+ if (is.null(split.by)) {
+ if (id %in% colnames(object@meta.data)) {
# using seurat_clusters or Idents
geneExp$id <- object@meta.data[[id]]
- }else{
+ } else {
geneExp$id <- Seurat::Idents(object)
}
- }else{
+ } else {
# using seurat_clusters or Idents
- if(id %in% colnames(object@meta.data)){
+ if (id %in% colnames(object@meta.data)) {
geneExp$id <- paste(object@meta.data[[id]],
- " (",object@meta.data[[split.by]],")",
- sep = '')
- }else{
+ " (", object@meta.data[[split.by]], ")",
+ sep = ""
+ )
+ } else {
geneExp$id <- paste(Seurat::Idents(object),
- " (",object@meta.data[[split.by]],")",
- sep = '')
+ " (", object@meta.data[[split.by]], ")",
+ sep = ""
+ )
}
}
@@ -195,24 +210,27 @@ jjDotPlot <- function(object = NULL,
)
pct.exp <- apply(X = data.use, MARGIN = 2, FUN = PercentAbove, threshold = 0)
- res <- data.frame(id = ident,avg.exp = avg.exp, pct.exp = pct.exp*100)
+ res <- data.frame(id = ident, avg.exp = avg.exp, pct.exp = pct.exp * 100)
res$gene <- rownames(res)
return(res)
}
- ) %>% do.call('rbind',.) %>% data.frame()
+ ) %>%
+ do.call("rbind", .) %>%
+ data.frame()
# scale mean expressions
- if(scale == TRUE){
- purrr::map_df(unique(data.plot$gene),function(x){
- tmp <- data.plot %>% dplyr::filter(gene == x)
+ if (scale == TRUE) {
+ purrr::map_df(unique(data.plot$gene), function(x) {
+ tmp <- data.plot %>%
+ dplyr::filter(gene == x)
- # scale value corss groups
- if(rescale == TRUE){
+ # scale value cross groups
+ if (rescale == TRUE) {
avg.exp.scale <- tmp %>%
dplyr::select(avg.exp) %>%
scale(.) %>%
- scales::rescale(.,to = c(rescale.min,rescale.max))
- }else{
+ scales::rescale(., to = c(rescale.min, rescale.max))
+ } else {
avg.exp.scale <- tmp %>%
dplyr::select(avg.exp) %>%
scale(.) %>%
@@ -223,150 +241,185 @@ jjDotPlot <- function(object = NULL,
tmp$avg.exp.scaled <- as.numeric(avg.exp.scale)
return(tmp)
}) -> data.plot
- }else{
+ } else {
# no scale or rescale using log1p
data.plot$avg.exp.scaled <- log1p(data.plot$avg.exp)
}
- if(!is.null(markerGene)){
+ if (!is.null(markerGene)) {
celltype_info <- markerGene
# add celltype
- purrr::map_df(1:nrow(data.plot),function(x){
- tmp <- data.plot[x,]
- tmp$celltype <- celltype_info[which(celltype_info$gene == tmp$gene),aesGroName][[1]]
+ purrr::map_df(seq_len(nrow(data.plot)), function(x) {
+ tmp <- data.plot[x, ]
+ tmp$celltype <- celltype_info[which(celltype_info$gene == tmp$gene), aesGroName][[1]]
return(tmp)
}) -> data.plot.res
# arrange cell type
data.plot.res <- data.plot.res %>%
dplyr::arrange(celltype)
- }else{
+ } else {
data.plot.res <- data.plot
}
# gene order
- if(is.null(gene.order)){
- data.plot.res$gene <- factor(data.plot.res$gene,levels = unique(data.plot.res$gene))
- }else{
- data.plot.res$gene <- factor(data.plot.res$gene,levels = unique(gene.order))
+ if (is.null(gene.order)) {
+ data.plot.res$gene <- factor(data.plot.res$gene, levels = unique(data.plot.res$gene))
+ } else {
+ data.plot.res$gene <- factor(data.plot.res$gene, levels = unique(gene.order))
}
# cluster order
- if(!is.null(cluster.order)){
- data.plot.res$id <- factor(data.plot.res$id,levels = unique(cluster.order))
+ if (!is.null(cluster.order)) {
+ data.plot.res$id <- factor(data.plot.res$id, levels = unique(cluster.order))
}
# add group info
- if(!is.null(split.by)){
- data.plot.res$group <- sapply(strsplit(as.character(data.plot.res$id),split = '\\(|\\)'),'[',2)
+ if (!is.null(split.by)) {
+ data.plot.res$group <- sapply(strsplit(as.character(data.plot.res$id), split = "\\(|\\)"), "[", 2)
}
# ============================================================================
# plot
- pmain <- ggplot2::ggplot(data.plot.res,
- ggplot2::aes(x = gene,y = id)) +
+ pmain <- ggplot2::ggplot(
+ data.plot.res,
+ ggplot2::aes(x = gene, y = id)
+ ) +
ggplot2::theme_bw(base_size = base_size) +
- ggplot2::xlab('') + ggplot2::ylab('') +
+ ggplot2::xlab("") +
+ ggplot2::ylab("") +
ggplot2::coord_fixed(clip = "off") +
- ggplot2::theme(plot.margin = ggplot2::margin(t = plot.margin[1],r = plot.margin[2],
- b = plot.margin[3],l = plot.margin[4],
- unit = "cm"),
- axis.text = ggplot2::element_text(color = "black"),
- legend.direction = "horizontal",
- axis.text.x = ggplot2::element_text(angle = x.text.angle,
- hjust = x.text.hjust,
- vjust = x.text.vjust),
- legend.position = legend.position)
+ ggplot2::theme(
+ plot.margin = ggplot2::margin(
+ t = plot.margin[1], r = plot.margin[2],
+ b = plot.margin[3], l = plot.margin[4],
+ unit = "cm"
+ ),
+ axis.text = ggplot2::element_text(color = "black"),
+ legend.direction = "horizontal",
+ axis.text.x = ggplot2::element_text(
+ angle = x.text.angle,
+ hjust = x.text.hjust,
+ vjust = x.text.vjust
+ ),
+ legend.position = legend.position
+ )
# colorbar layer
- colorbar.layer <- ggplot2::guides(fill = ggplot2::guide_colorbar(title = bar.legendTitle,
- title.position = "top",
- title.hjust = 0.5,
- barwidth = unit(bar.width,"cm"),
- frame.colour = "black",
- frame.linewidth = 0.8,
- ticks.colour = "black"))
+ colorbar.layer <- ggplot2::guides(
+ fill = ggplot2::guide_colorbar(
+ title = bar.legendTitle,
+ title.position = "top",
+ title.hjust = 0.5,
+ barwidth = unit(bar.width, "cm"),
+ frame.colour = "black",
+ frame.linewidth = 0.8,
+ ticks.colour = "black"
+ )
+ )
# point size layer
- point.layer <- ggplot2::guides(size = ggplot2::guide_legend(title = point.lengdTitle,
- title.position = "top",
- title.hjust = 0.5,
- label.position = "bottom",
- override.aes = list(color = "black",
- fill = "grey50"),
- keywidth = ggplot2::unit(size.width,"cm")))
+ point.layer <- ggplot2::guides(
+ size = ggplot2::guide_legend(
+ title = point.legendTitle,
+ title.position = "top",
+ title.hjust = 0.5,
+ label.position = "bottom",
+ override.aes = list(
+ color = "black",
+ fill = "grey50"
+ ),
+ keywidth = ggplot2::unit(size.width, "cm")
+ )
+ )
- # chenge colors
- if(is.null(split.by)){
- if(length(dot.col) == 2){
+ # change colors
+ if (is.null(split.by)) {
+ if (length(dot.col) == 2) {
pmain <- pmain +
- ggplot2::scale_fill_gradient(low = dot.col[1],high = dot.col[2])
- }else{
+ ggplot2::scale_fill_gradient(low = dot.col[1], high = dot.col[2])
+ } else {
pmain <- pmain +
- ggplot2::scale_fill_gradient2(low = dot.col[1],
- mid = dot.col[2],
- high = dot.col[3],
- midpoint = midpoint)
+ ggplot2::scale_fill_gradient2(
+ low = dot.col[1],
+ mid = dot.col[2],
+ high = dot.col[3],
+ midpoint = midpoint
+ )
}
- }else{
- if(split.by.aesGroup == FALSE){
+ } else {
+ if (split.by.aesGroup == FALSE) {
pmain <- pmain +
ggplot2::scale_fill_manual(values = dot.col)
- }else{
- if(length(dot.col) == 2){
+ } else {
+ if (length(dot.col) == 2) {
pmain <- pmain +
- ggplot2::scale_fill_gradient(low = dot.col[1],high = dot.col[2])
- }else{
+ ggplot2::scale_fill_gradient(low = dot.col[1], high = dot.col[2])
+ } else {
pmain <- pmain +
- ggplot2::scale_fill_gradient2(low = dot.col[1],
- mid = dot.col[2],
- high = dot.col[3],
- midpoint = midpoint)
+ ggplot2::scale_fill_gradient2(
+ low = dot.col[1],
+ mid = dot.col[2],
+ high = dot.col[3],
+ midpoint = midpoint
+ )
}
}
}
# add point or tile layer
- if(point.geom == TRUE){
- if(is.null(split.by)){
+ if (point.geom == TRUE) {
+ if (is.null(split.by)) {
pmain <- pmain +
- ggplot2::geom_point(ggplot2::aes(fill = avg.exp.scaled,size = pct.exp),
- color = "black",shape = point.shape) +
+ ggplot2::geom_point(
+ ggplot2::aes(fill = avg.exp.scaled, size = pct.exp),
+ color = "black", shape = point.shape
+ ) +
colorbar.layer +
point.layer +
- ggplot2::scale_size(range = c(dot.min,dot.max))
- }else{
- if(split.by.aesGroup == FALSE){
+ ggplot2::scale_size(range = c(dot.min, dot.max))
+ } else {
+ if (split.by.aesGroup == FALSE) {
pmain <- pmain +
- ggplot2::geom_point(ggplot2::aes(fill = group,size = pct.exp),
- color = "black",shape = point.shape) +
+ ggplot2::geom_point(
+ ggplot2::aes(fill = group, size = pct.exp),
+ color = "black", shape = point.shape
+ ) +
point.layer +
- ggplot2::scale_size(range = c(dot.min,dot.max))
- }else{
+ ggplot2::scale_size(range = c(dot.min, dot.max))
+ } else {
pmain <- pmain +
- ggplot2::geom_point(ggplot2::aes(fill = avg.exp.scaled,size = pct.exp),
- color = "black",shape = point.shape) +
+ ggplot2::geom_point(
+ ggplot2::aes(fill = avg.exp.scaled, size = pct.exp),
+ color = "black", shape = point.shape
+ ) +
colorbar.layer +
point.layer +
- ggplot2::scale_size(range = c(dot.min,dot.max))
+ ggplot2::scale_size(range = c(dot.min, dot.max))
}
}
- }else if(tile.geom == TRUE){
- if(is.null(split.by)){
+ } else if (tile.geom == TRUE) {
+ if (is.null(split.by)) {
pmain <- pmain +
- ggplot2::geom_tile(ggplot2::aes(fill = avg.exp.scaled),
- color = "black") +
+ ggplot2::geom_tile(
+ ggplot2::aes(fill = avg.exp.scaled),
+ color = "black"
+ ) +
colorbar.layer
- }else{
- if(split.by.aesGroup == FALSE){
+ } else {
+ if (split.by.aesGroup == FALSE) {
pmain <- pmain +
- ggplot2::geom_tile(ggplot2::aes(fill = group),
- color = "black") +
+ ggplot2::geom_tile(
+ ggplot2::aes(fill = group),
+ color = "black"
+ ) +
colorbar.layer
- }else{
+ } else {
pmain <- pmain +
- ggplot2::geom_tile(ggplot2::aes(fill = avg.exp.scaled),
- color = "black") +
+ ggplot2::geom_tile(
+ ggplot2::aes(fill = avg.exp.scaled),
+ color = "black"
+ ) +
colorbar.layer
}
}
@@ -374,77 +427,91 @@ jjDotPlot <- function(object = NULL,
# long to wide matrix
plot.matrix <- data.plot.res %>%
- reshape2::dcast(id~gene,value.var = "avg.exp.scaled")
+ reshape2::dcast(id ~ gene, value.var = "avg.exp.scaled")
rownames(plot.matrix) <- plot.matrix$id
plot.matrix <- plot.matrix %>% dplyr::select(-id)
# =======================================
# define label position
- if(is.null(tree.pos)){
- if(ytree == TRUE & xtree == FALSE){
- tree.pos = c("right","right")
- }else if(xtree == TRUE & ytree == FALSE){
- tree.pos = c("top","top")
- }else{
- tree.pos = c("right","top")
+ if (is.null(tree.pos)) {
+ if (ytree == TRUE && xtree == FALSE) {
+ tree.pos <- c("right", "right")
+ } else if (xtree == TRUE && ytree == FALSE) {
+ tree.pos <- c("top", "top")
+ } else {
+ tree.pos <- c("right", "top")
}
- }else{
- tree.pos = tree.pos
+ } else {
+ tree.pos <- tree.pos
}
# add ytree
- if(ytree == TRUE){
+ if (ytree == TRUE) {
# whether put label same with tree
- if(same.pos.label == FALSE){
+ if (same.pos.label == FALSE) {
pytree <- pmain +
- ggh4x::scale_y_dendrogram(hclust = stats::hclust(stats::dist(plot.matrix)),
- position = tree.pos[1],
- labels = NULL) +
- ggplot2::guides(y.sec = ggh4x::guide_axis_manual(labels = function(x){x}))
- }else{
+ ggh4x::scale_y_dendrogram(
+ hclust = stats::hclust(stats::dist(plot.matrix)),
+ position = tree.pos[1],
+ labels = NULL
+ ) +
+ ggplot2::guides(y.sec = ggh4x::guide_axis_manual(labels = function(x) {
+ x
+ }))
+ } else {
pytree <- pmain +
- ggh4x::scale_y_dendrogram(hclust = stats::hclust(stats::dist(plot.matrix)),
- position = tree.pos[1])
+ ggh4x::scale_y_dendrogram(
+ hclust = stats::hclust(stats::dist(plot.matrix)),
+ position = tree.pos[1]
+ )
}
- }else{
+ } else {
pytree <- pmain
}
# add xtree
- if(xtree == TRUE){
+ if (xtree == TRUE) {
# whether put label same with tree
- if(same.pos.label == FALSE){
+ if (same.pos.label == FALSE) {
pxtree <- pytree +
- ggh4x::scale_x_dendrogram(hclust = stats::hclust(stats::dist(t(plot.matrix))),
- position = tree.pos[2],
- labels = NULL) +
- ggplot2::guides(x.sec = ggh4x::guide_axis_manual(labels = function(x){x}))
- }else{
+ ggh4x::scale_x_dendrogram(
+ hclust = stats::hclust(stats::dist(t(plot.matrix))),
+ position = tree.pos[2],
+ labels = NULL
+ ) +
+ ggplot2::guides(x.sec = ggh4x::guide_axis_manual(labels = function(x) {
+ x
+ }))
+ } else {
pxtree <- pytree +
- ggh4x::scale_x_dendrogram(hclust = stats::hclust(stats::dist(t(plot.matrix))),
- position = tree.pos[2])
+ ggh4x::scale_x_dendrogram(
+ hclust = stats::hclust(stats::dist(t(plot.matrix))),
+ position = tree.pos[2]
+ )
}
- }else{
+ } else {
pxtree <- pytree
}
# ================================
# add celltype annotation
- if(!is.null(markerGene) & anno == TRUE){
- panno <- jjAnno::annoSegment(object = pxtree,
- annoPos = 'top',
- aesGroup = T,
- aesGroName = "celltype",
- segWidth = 0.8,
- lwd = 3,addBranch = T,branDirection = -1,
- pCol = rep('black',length(unique(celltype_info$cluster))),
- addText = T,textRot = 90,
- textCol = rep('black',length(unique(celltype_info$cluster))),
- textSize = 14,
- hjust = 0,
- ...)
- }else{
+ if (!is.null(markerGene) && anno == TRUE) {
+ panno <- jjAnno::annoSegment(
+ object = pxtree,
+ annoPos = "top",
+ aesGroup = TRUE,
+ aesGroName = "celltype",
+ segWidth = 0.8,
+ lwd = 3, addBranch = TRUE, branDirection = -1,
+ pCol = rep("black", length(unique(celltype_info$cluster))),
+ addText = TRUE, textRot = 90,
+ textCol = rep("black", length(unique(celltype_info$cluster))),
+ textSize = 14,
+ hjust = 0,
+ ...
+ )
+ } else {
panno <- pxtree
}
return(panno)
@@ -453,7 +520,7 @@ jjDotPlot <- function(object = NULL,
###############################
#' This is a test data for this package
-#' test data describtion
+#' test data description
#'
#' @name top3pbmc.markers
#' @docType data
diff --git a/R/jjVolcano.R b/R/jjVolcano.R
index 89c8a81..093fd53 100644
--- a/R/jjVolcano.R
+++ b/R/jjVolcano.R
@@ -6,20 +6,20 @@
#' @param myMarkers whether supply your own gene labels, default NULL.
#' @param log2FC.cutoff log2FoldChange cutoff, default 0.25.
#' @param pvalue.cutoff pvalue cutoff to filter, default 0.05.
-#' @param adjustP.cutoff ajusted pvalue cutoff to be colored in plot, default 0.01.
+#' @param adjustP.cutoff adjusted pvalue cutoff to be colored in plot, default 0.01.
#' @param topGeneN top genes to be labeled in plot, default 5.
-#' @param col.type point color type('updown/adjustP'), default "updown".
+#' @param col.type point color type("updown/adjustP"), default "updown".
#' @param back.col background color, default "grey93".
#' @param pSize point size, default 0.75.
-#' @param aesCol point mapping color, default c('#0099CC','#CC3333').
+#' @param aesCol point mapping color, default c("#0099CC","#CC3333").
#' @param legend.position legend position in plot, default c(0.7,0.9).
#' @param base_size theme base size, default 14.
#' @param tile.col cluster tile fill color, default jjAnno::useMyCol("paired",n = 9).
#' @param ... other arguments passed by "geom_text_repel".
#' @param cluster.order whether given your cluster orders, default NULL.
-#' @param polar whether make the plot to br polar, default FASLE.
+#' @param polar whether make the plot to br polar, default FALSE.
#' @param expand the y axis expand, default c(-1,1).
-#' @param flip whether flip the plot, default FASLE.
+#' @param flip whether flip the plot, default FALSE.
#'
#' @param order.by top marker gene selection method, how the order is, default c("avg_log2FC").
#'
@@ -27,53 +27,59 @@
#' @export
#'
#' @examples
-#' \dontrun{jjVolcano(diffData = pbmc.markers)}
-
-globalVariables(c('p_val', 'p_val_adj', 'type', 'type2'))
-jjVolcano <- function(diffData = NULL,
- myMarkers = NULL,
- order.by = c("avg_log2FC"), # c("avg_log2FC","p_val")
- log2FC.cutoff = 0.25,
- pvalue.cutoff = 0.05,
- adjustP.cutoff = 0.01,
- topGeneN = 5,
- col.type = "updown",
- back.col = 'grey93',
- pSize = 0.75,
- aesCol = c('#0099CC','#CC3333'),
- legend.position = c(0.7,0.9),
- base_size = 14,
- tile.col = jjAnno::useMyCol("paired",n = 9),
- cluster.order = NULL,
- polar = FALSE,
- expand = c(-1,1),
- flip = FALSE,
- ...){
+#' \dontrun{
+#' jjVolcano(diffData = pbmc.markers)
+#' }
+globalVariables(c("p_val", "p_val_adj", "type", "type2"))
+jjVolcano <- function(
+ diffData = NULL,
+ myMarkers = NULL,
+ order.by = c("avg_log2FC"), # c("avg_log2FC","p_val")
+ log2FC.cutoff = 0.25,
+ pvalue.cutoff = 0.05,
+ adjustP.cutoff = 0.01,
+ topGeneN = 5,
+ col.type = "updown",
+ back.col = "grey93",
+ pSize = 0.75,
+ aesCol = c("#0099CC", "#CC3333"),
+ legend.position = c(0.7, 0.9),
+ base_size = 14,
+ tile.col = jjAnno::useMyCol("paired", n = 9),
+ cluster.order = NULL,
+ polar = FALSE,
+ expand = c(-1, 1),
+ flip = FALSE,
+ ...) {
# filter data
diff.marker <- diffData %>%
dplyr::filter(abs(avg_log2FC) >= log2FC.cutoff & p_val < pvalue.cutoff)
# assign type
diff.marker <- diff.marker %>%
- dplyr::mutate(type = ifelse(avg_log2FC >= log2FC.cutoff,"sigUp","sigDown")) %>%
+ dplyr::mutate(type = ifelse(avg_log2FC >= log2FC.cutoff, "sigUp", "sigDown")) %>%
dplyr::mutate(type2 = ifelse(p_val_adj < adjustP.cutoff,
- paste("adjust Pvalue < ",adjustP.cutoff,sep = ''),
- paste("adjust Pvalue >= ",adjustP.cutoff,sep = '')))
+ paste("adjust Pvalue < ", adjustP.cutoff, sep = ""),
+ paste("adjust Pvalue >= ", adjustP.cutoff, sep = "")
+ ))
# cluster orders
- if(!is.null(cluster.order)){
+ if (!is.null(cluster.order)) {
diff.marker$cluster <- factor(diff.marker$cluster,
- levels = cluster.order)
+ levels = cluster.order
+ )
}
# get background cols
- purrr::map_df(unique(diff.marker$cluster),function(x){
+ purrr::map_df(unique(diff.marker$cluster), function(x) {
tmp <- diff.marker %>%
dplyr::filter(cluster == x)
- new.tmp <- data.frame(cluster = x,
- min = min(tmp$avg_log2FC) - 0.2,
- max = max(tmp$avg_log2FC) + 0.2)
+ new.tmp <- data.frame(
+ cluster = x,
+ min = min(tmp$avg_log2FC) - 0.2,
+ max = max(tmp$avg_log2FC) + 0.2
+ )
return(new.tmp)
}) -> back.data
@@ -101,100 +107,119 @@ jjVolcano <- function(diffData = NULL,
# }
top.marker.max <- top.marker.tmp %>%
- dplyr::slice_max(n = topGeneN,order_by = get(order.by))
+ dplyr::slice_max(n = topGeneN, order_by = get(order.by))
top.marker.min <- top.marker.tmp %>%
- dplyr::slice_min(n = topGeneN,order_by = get(order.by))
+ dplyr::slice_min(n = topGeneN, order_by = get(order.by))
# combine
- top.marker <- rbind(top.marker.max,top.marker.min)
+ top.marker <- rbind(top.marker.max, top.marker.min)
# whether supply own genes
- if(!is.null(myMarkers)){
+ if (!is.null(myMarkers)) {
top.marker <- diff.marker %>%
dplyr::filter(gene %in% myMarkers)
- }else{
+ } else {
top.marker <- top.marker
}
# ====================================================================
# plot
- p1 <- ggplot2::ggplot(diff.marker,
- ggplot2::aes(x = cluster,y = avg_log2FC)) +
+ p1 <- ggplot2::ggplot(
+ diff.marker,
+ ggplot2::aes(x = cluster, y = avg_log2FC)
+ ) +
# add back cols
- ggplot2::geom_col(data = back.data,
- ggplot2::aes(x = cluster,y = min),fill = back.col) +
- ggplot2::geom_col(data = back.data,
- ggplot2::aes(x = cluster,y = max),fill = back.col)
-
- # ap1 <- paste("adjust Pvalue >= ",adjustP.cutoff,sep = '')
- # ap2 <- paste("adjust Pvalue < ",adjustP.cutoff,sep = '')
+ ggplot2::geom_col(
+ data = back.data,
+ ggplot2::aes(x = cluster, y = min), fill = back.col
+ ) +
+ ggplot2::geom_col(
+ data = back.data,
+ ggplot2::aes(x = cluster, y = max), fill = back.col
+ )
+
+ # ap1 <- paste("adjust Pvalue >= ", adjustP.cutoff, sep = '')
+ # ap2 <- paste("adjust Pvalue < ", adjustP.cutoff, sep = '')
# color type
- if(col.type == "updown"){
+ if (col.type == "updown") {
p2 <- p1 +
# add point
- ggplot2::geom_jitter(ggplot2::aes(color = type),size = pSize) +
- ggplot2::scale_color_manual(values = c("sigDown" = aesCol[1],"sigUp" = aesCol[2]))
- }else if(col.type == "adjustP"){
+ ggplot2::geom_jitter(ggplot2::aes(color = type), size = pSize) +
+ ggplot2::scale_color_manual(values = c("sigDown" = aesCol[1], "sigUp" = aesCol[2]))
+ } else if (col.type == "adjustP") {
p2 <- p1 +
# add point
- ggplot2::geom_jitter(ggplot2::aes(color = type2),size = pSize) +
- ggplot2::scale_color_manual(values = c(aesCol[2],aesCol[1]))
+ ggplot2::geom_jitter(ggplot2::aes(color = type2), size = pSize) +
+ ggplot2::scale_color_manual(values = c(aesCol[2], aesCol[1]))
}
# theme details
p3 <- p2 +
ggplot2::scale_y_continuous(n.breaks = 6) +
ggplot2::theme_classic(base_size = base_size) +
- ggplot2::theme(panel.grid = ggplot2::element_blank(),
- legend.position = legend.position,
- legend.title = ggplot2::element_blank(),
- legend.background = ggplot2::element_blank()) +
- ggplot2::xlab('Clusters') + ggplot2::ylab('Average log2FoldChange') +
+ ggplot2::theme(
+ panel.grid = ggplot2::element_blank(),
+ legend.position = legend.position,
+ legend.title = ggplot2::element_blank(),
+ legend.background = ggplot2::element_blank()
+ ) +
+ ggplot2::xlab("Clusters") + ggplot2::ylab("Average log2FoldChange") +
ggplot2::guides(color = ggplot2::guide_legend(override.aes = list(size = 5)))
# add tile
p4 <- p3 +
- ggplot2::geom_tile(ggplot2::aes(x = cluster,y = 0,fill = cluster),
- color = 'black',
- height = log2FC.cutoff*2,
- alpha = 0.3,
- show.legend = F) +
+ ggplot2::geom_tile(ggplot2::aes(x = cluster, y = 0, fill = cluster),
+ color = "black",
+ height = log2FC.cutoff * 2,
+ alpha = 0.3,
+ show.legend = FALSE
+ ) +
ggplot2::scale_fill_manual(values = tile.col) +
# add gene label
- ggrepel::geom_text_repel(data = top.marker,
- ggplot2::aes(x = cluster,y = avg_log2FC,label = gene),
- max.overlaps = 50,
- ...)
+ ggrepel::geom_text_repel(
+ data = top.marker,
+ ggplot2::aes(x = cluster, y = avg_log2FC, label = gene),
+ max.overlaps = 50,
+ ...
+ )
# whether coord_plolar
- if(polar == TRUE){
+ if (polar == TRUE) {
p5 <- p4 +
- geomtextpath::geom_textpath(ggplot2::aes(x = cluster,y = 0,label = cluster)) +
- ggplot2::scale_y_continuous(n.breaks = 6,
- expand = ggplot2::expansion(mult = expand)) +
+ geomtextpath::geom_textpath(ggplot2::aes(x = cluster, y = 0, label = cluster)) +
+ ggplot2::scale_y_continuous(
+ n.breaks = 6,
+ expand = ggplot2::expansion(mult = expand)
+ ) +
ggplot2::theme_void(base_size = base_size) +
- ggplot2::theme(legend.position = legend.position,
- legend.title = ggplot2::element_blank()) +
- ggplot2::coord_polar(clip = 'off',theta = 'x')
- }else{
+ ggplot2::theme(
+ legend.position = legend.position,
+ legend.title = ggplot2::element_blank()
+ ) +
+ ggplot2::coord_polar(clip = "off", theta = "x")
+ } else {
# whether flip plot
- if(flip == TRUE){
+ if (flip == TRUE) {
p5 <- p4 +
ggplot2::scale_y_continuous(n.breaks = 6) +
- ggplot2::geom_label(ggplot2::aes(x = cluster,y = 0,label = cluster)) +
- ggplot2::theme(axis.line.y = ggplot2::element_blank(),
- axis.text.y = ggplot2::element_blank(),
- axis.ticks.y = ggplot2::element_blank()) +
+ ggplot2::geom_label(ggplot2::aes(x = cluster, y = 0, label = cluster)) +
+ ggplot2::theme(
+ axis.line.y = ggplot2::element_blank(),
+ axis.text.y = ggplot2::element_blank(),
+ axis.ticks.y = ggplot2::element_blank()
+ ) +
ggplot2::coord_flip()
- }else{
+ } else {
p5 <- p4 +
ggplot2::scale_y_continuous(n.breaks = 6) +
- ggplot2::geom_text(ggplot2::aes(x = cluster,y = 0,label = cluster)) +
- ggplot2::theme(axis.line.x = ggplot2::element_blank(),
- axis.text.x = ggplot2::element_blank(),
- axis.ticks.x = ggplot2::element_blank())
+ ggplot2::geom_text(ggplot2::aes(x = cluster, y = 0, label = cluster)) +
+ ggplot2::theme(
+ axis.line.x = ggplot2::element_blank(),
+ axis.text.x = ggplot2::element_blank(),
+ axis.ticks.x = ggplot2::element_blank()
+ )
}
}
return(p5)
@@ -202,7 +227,7 @@ jjVolcano <- function(diffData = NULL,
###############################
#' This is a test data for this package
-#' test data describtion
+#' test data description
#'
#' @name pbmc.markers
#' @docType data
diff --git a/R/markerVocalno.R b/R/markerVolcano.R
similarity index 51%
rename from R/markerVocalno.R
rename to R/markerVolcano.R
index d21a7d6..6166cbe 100644
--- a/R/markerVocalno.R
+++ b/R/markerVolcano.R
@@ -1,21 +1,22 @@
-#' @name markerVocalno
+#' @name markerVolcano
#' @author Junjun Lao
-#' @title Marker genes vocalno plot
+#' @title Marker genes volcano plot
+#'
#' @param markers Dataframe marker genes from findAllmarkers function from seurat.
#' @param ownGene Your own gene names to be labeled on plot, defaults is null.
#' @param topn Numbers top genes to label, defaults is 5.
#' @param log2FC The threshold of log2FC, defaults is 0.25.
#' @param hlineSize Hline size, defaults is 1.
-#' @param hlineColor Hline color, defaults is 'grey50'.
+#' @param hlineColor Hline color, defaults is "grey50".
#' @param pforce Positive gene force parameters to avoid overlap gene labels, defaults is 5.
-#' @param nforce Negtive gene force parameters to avoid overlap gene labels, defaults is 2.5.
-#' @param nudge_x Ajustments on the horizotal of the gene label, defaults is 0.8.
-#' @param pnudge_y Ajustments on the horizotal of the positive gene label, defaults is 0.25.
-#' @param nnudge_y Ajustments on the horizotal of the negtive gene label, defaults is 0.
+#' @param nforce Negative gene force parameters to avoid overlap gene labels, defaults is 2.5.
+#' @param nudge_x Adjustments on the horizontal of the gene label, defaults is 0.8.
+#' @param pnudge_y Adjustments on the horizontal of the positive gene label, defaults is 0.25.
+#' @param nnudge_y Adjustments on the horizontal of the negative gene label, defaults is 0.
#' @param base_size Theme base size, defaults is 14.
#' @param facetColor Facet border color, defaults is NA.
-#' @param facetFill Facet fill color, defaults is 'white'.
-#' @param ylab Plot y label, defaults is 'Log2-Fold Change'.
+#' @param facetFill Facet fill color, defaults is "white".
+#' @param ylab Plot y label, defaults is "Log2-Fold Change".
#' @param nrow Numbers rows to plot, defaults is 1.
#'
#' @return Return a ggplot.
@@ -25,54 +26,60 @@
#' test <- system.file("extdata", "pbmc.markers.csv", package = "scRNAtoolVis")
#' markers <- read.csv(test)
#'
-#' markerVocalno(markers = markers,
-#' topn = 5,
-#' labelCol = ggsci::pal_npg()(9))
-
-# define viriables
+#' markerVolcano(
+#' markers = markers,
+#' topn = 5,
+#' labelCol = ggsci::pal_npg()(9)
+#' )
+# define variables
globalVariables(c("avg_log2FC", "cluster", "gene", "pct.1", "pct.2"))
# define function
-markerVocalno <- function(markers = NULL,
- ownGene = NULL,
- topn = 5,
- log2FC = 0.25,
- labelCol = NULL,
- hlineSize = 1,
- hlineColor = 'grey50',
- pforce = 5,
- nforce = 2.5,
- nudge_x = 0.8,
- pnudge_y = 0.25,
- nnudge_y = 0,
- base_size = 14,
- facetColor = NA,
- facetFill = 'white',
- ylab = 'Log2-Fold Change',
- nrow = 1) {
+markerVolcano <- function(
+ markers = NULL,
+ ownGene = NULL,
+ topn = 5,
+ log2FC = 0.25,
+ labelCol = NULL,
+ hlineSize = 1,
+ hlineColor = "grey50",
+ pforce = 5,
+ nforce = 2.5,
+ nudge_x = 0.8,
+ pnudge_y = 0.25,
+ nnudge_y = 0,
+ base_size = 14,
+ facetColor = NA,
+ facetFill = "white",
+ ylab = "Log2-Fold Change",
+ nrow = 1) {
# whether supply own gene names
- if(is.null(ownGene)){
+ if (is.null(ownGene)) {
# top genes
- toppos <- markers %>% dplyr::group_by(cluster) %>%
+ toppos <- markers %>%
+ dplyr::group_by(cluster) %>%
dplyr::top_n(n = topn, wt = avg_log2FC)
- topnegtive <- markers %>% dplyr::group_by(cluster) %>%
+ topneg <- markers %>%
+ dplyr::group_by(cluster) %>%
dplyr::top_n(n = -topn, wt = avg_log2FC)
# merge
- topgene <- rbind(toppos, topnegtive)
- }else{
+ topgene <- rbind(toppos, topneg)
+ } else {
topgene <- markers %>% dplyr::filter(gene %in% ownGene)
toppos <- topgene %>% dplyr::filter(avg_log2FC > 0)
- topnegtive <- topgene %>% dplyr::filter(avg_log2FC < 0)
+ topneg <- topgene %>% dplyr::filter(avg_log2FC < 0)
}
# plot
- ggplot2::ggplot(markers,
- ggplot2::aes(x = pct.1 - pct.2, y = avg_log2FC)) +
- ggplot2::geom_point(color = 'grey80') +
+ ggplot2::ggplot(
+ markers,
+ ggplot2::aes(x = pct.1 - pct.2, y = avg_log2FC)
+ ) +
+ ggplot2::geom_point(color = "grey80") +
ggplot2::geom_hline(
yintercept = c(-log2FC, log2FC),
- lty = 'dashed',
+ lty = "dashed",
size = hlineSize,
color = hlineColor
) +
@@ -84,38 +91,38 @@ markerVocalno <- function(markers = NULL,
label = gene,
color = cluster
),
- show.legend = F,
- direction = 'y',
+ show.legend = FALSE,
+ direction = "y",
hjust = 1,
nudge_y = pnudge_y,
force = pforce,
nudge_x = -nudge_x - (toppos$pct.1 - toppos$pct.2)
) +
ggrepel::geom_text_repel(
- data = topnegtive,
+ data = topneg,
ggplot2::aes(
x = pct.1 - pct.2,
y = avg_log2FC,
label = gene,
color = cluster
),
- show.legend = F,
- direction = 'y',
+ show.legend = FALSE,
+ direction = "y",
hjust = 0,
nudge_y = nnudge_y,
force = nforce,
- nudge_x = nudge_x - (topnegtive$pct.1 - topnegtive$pct.2)
+ nudge_x = nudge_x - (topneg$pct.1 - topneg$pct.2)
) +
ggplot2::geom_point(
data = topgene,
- show.legend = F,
+ show.legend = FALSE,
ggplot2::aes(
x = pct.1 - pct.2,
y = avg_log2FC,
color = cluster
)
) +
- ggplot2::scale_color_manual(name = '', values = labelCol) +
+ ggplot2::scale_color_manual(name = "", values = labelCol) +
# x y breaks label
# scale_y_continuous(limits = c(-6,10),breaks = seq(-6,10,2)) +
# scale_x_continuous(limits = c(-1,1),breaks = seq(-1,1,0.5)) +
@@ -125,7 +132,7 @@ markerVocalno <- function(markers = NULL,
axis.text.x = ggplot2::element_text(angle = 45, hjust = 1),
strip.background = ggplot2::element_rect(color = facetColor, fill = facetFill)
) +
- ggplot2::xlab(expression(Delta ~ 'Percentage Difference')) +
+ ggplot2::xlab(expression(Delta ~ "Percentage Difference")) +
ggplot2::ylab(ylab) +
- ggplot2::facet_wrap(~ cluster, nrow = nrow, scales = 'fixed')
+ ggplot2::facet_wrap(~cluster, nrow = nrow, scales = "fixed")
}
diff --git a/R/scatterCellPlot.R b/R/scatterCellPlot.R
index e4211fa..c3904db 100644
--- a/R/scatterCellPlot.R
+++ b/R/scatterCellPlot.R
@@ -1,9 +1,6 @@
-globalVariables(c("idents"))
-#' Scatter Cell Plot
-#'
-#' This function creates a scatter cell plot using the grid package in R.
-#'
+#' @name scatterCellPlot
#' @author Jun Zhang
+#' @title This function creates a scatter cell plot using the grid package in R.
#'
#' @param object A Seurat object containing the data.
#' @param color A vector of colors for each cell type. If NULL, random colors will be assigned.
@@ -19,21 +16,27 @@ globalVariables(c("idents"))
#' @return None
#'
#' @examples
-#' \dontrun{scatterCellPlot(object = seurat_object)}
+#' \dontrun{
+#' scatterCellPlot(object = seurat_object)
+#' }
#'
#' @importFrom grid grid.newpage pushViewport popViewport viewport grid.rect grid.xaxis grid.yaxis grid.points grid.segments grid.text arrow gpar
#'
#' @export
-scatterCellPlot <- function(object = NULL,
- color = NULL,
- dim = "umap",
- rm.axis = FALSE,
- cell.id = NULL,
- bar.width = 0.2,
- point.size = 1,
- rm.barplot = FALSE,
- legend.psize = 1.5,
- arrow.len = 0.2){
+
+globalVariables(c("idents"))
+
+scatterCellPlot <- function(
+ object = NULL,
+ color = NULL,
+ dim = "umap",
+ rm.axis = FALSE,
+ cell.id = NULL,
+ bar.width = 0.2,
+ point.size = 1,
+ rm.barplot = FALSE,
+ legend.psize = 1.5,
+ arrow.len = 0.2) {
# ============================================================================
# 1_extract data
# ============================================================================
@@ -48,14 +51,14 @@ scatterCellPlot <- function(object = NULL,
pc12$idents <- as.character(Seurat::Idents(object))
# summary celltype numbers
- if(is.null(cell.id)){
+ if (is.null(cell.id)) {
cell_num <- pc12 |>
dplyr::group_by(idents) |>
dplyr::summarise(n = dplyr::n()) |>
dplyr::arrange(n)
- }else{
+ } else {
cell_num <- pc12 |>
- dplyr::group_by(idents,.data[[cell.id]]) |>
+ dplyr::group_by(idents, .data[[cell.id]]) |>
dplyr::summarise(n = dplyr::n()) |>
dplyr::arrange(n)
}
@@ -63,22 +66,25 @@ scatterCellPlot <- function(object = NULL,
# ============================================================================
# 2_draw plot
# ============================================================================
- if(rm.axis == FALSE){
- lab.shift = unit(-2.5,"lines")
- }else{
- lab.shift = unit(-1,"lines")
+ if (rm.axis == FALSE) {
+ lab.shift <- unit(-2.5, "lines")
+ } else {
+ lab.shift <- unit(-1, "lines")
}
grid.newpage()
- pushViewport(viewport(x = unit(0.1, "npc"), y = unit(0.5, "npc"),
- width = unit(0.5, "npc"),
- height = unit(0.7, "npc"),
- just = "left",
- xscale = grDevices::extendrange(range(pc12[,1]),f = 0.05),
- yscale = grDevices::extendrange(range(pc12[,2]),f = 0.05),
- ))
+ pushViewport(
+ viewport(
+ x = unit(0.1, "npc"), y = unit(0.5, "npc"),
+ width = unit(0.5, "npc"),
+ height = unit(0.7, "npc"),
+ just = "left",
+ xscale = grDevices::extendrange(range(pc12[, 1]), f = 0.05),
+ yscale = grDevices::extendrange(range(pc12[, 2]), f = 0.05),
+ )
+ )
grid.rect()
- if(rm.axis == FALSE){
+ if (rm.axis == FALSE) {
# grid.xaxis()
# grid.yaxis()
jjPlot::grid.xaxis2(label.space = 0.5)
@@ -87,91 +93,124 @@ scatterCellPlot <- function(object = NULL,
celltype <- cell_num$idents
- if(is.null(color)){
+ if (is.null(color)) {
# create colors
cols <- circlize::rand_color(n = length(celltype))
- }else{
+ } else {
cols <- color
}
# draw points
# i = 1
for (i in seq_along(celltype)) {
- # tmp <- pc12 |> dplyr::filter(idents == celltype[i])
- tmp <- pc12[which(pc12$idents %in% celltype[i]),]
-
- grid.points(x = tmp[,1],y = tmp[,2],pch = 19,size = unit(point.size,"pt"),
- gp = gpar(col = cols[i]))
+ # tmp <- pc12 |>
+ # dplyr::filter(idents == celltype[i])
+ tmp <- pc12[which(pc12$idents %in% celltype[i]), ]
+
+ grid.points(
+ x = tmp[, 1], y = tmp[, 2], pch = 19, size = unit(point.size, "pt"),
+ gp = gpar(col = cols[i])
+ )
}
# arrow
- if(rm.axis == TRUE){
- grid.segments(x0 = 0.025,x1 = arrow.len,y0 = 0.05,y1 = 0.05,
- arrow = arrow(length = unit(2,"mm"),type = "closed"),
- gp = gpar(fill = "black"))
- grid.text(label = paste0(toupper(dim)," 1"),x = (arrow.len+0.025)/2,y = 0.025,
- gp = gpar(fontsize = 6,fontface = "bold.italic"))
- grid.segments(x0 = 0.05,x1 = 0.05,y0 = 0.025,y1 = arrow.len,
- arrow = arrow(length = unit(2,"mm"),type = "closed"),
- gp = gpar(fill = "black"))
- grid.text(label = paste0(toupper(dim)," 2"),x = 0.025,y = (arrow.len+0.025)/2,rot = 90,gp =
- gpar(fontsize = 6,fontface = "bold.italic"))
- }else{
+ if (rm.axis == TRUE) {
+ grid.segments(
+ x0 = 0.025, x1 = arrow.len, y0 = 0.05, y1 = 0.05,
+ arrow = arrow(length = unit(2, "mm"), type = "closed"),
+ gp = gpar(fill = "black")
+ )
+ grid.text(
+ label = paste0(toupper(dim), " 1"),
+ x = (arrow.len + 0.025) / 2, y = 0.025,
+ gp = gpar(fontsize = 6, fontface = "bold.italic")
+ )
+ grid.segments(
+ x0 = 0.05, x1 = 0.05, y0 = 0.025, y1 = arrow.len,
+ arrow = arrow(length = unit(2, "mm"), type = "closed"),
+ gp = gpar(fill = "black")
+ )
+ grid.text(
+ label = paste0(toupper(dim), " 2"),
+ x = 0.025, y = (arrow.len + 0.025) / 2, rot = 90,
+ gp = gpar(fontsize = 6, fontface = "bold.italic")
+ )
+ } else {
# labs
- grid.text(label = paste0(toupper(dim)," dimension 1"),x = 0.5,y = lab.shift)
- grid.text(label = paste0(toupper(dim)," dimension 2"),x = lab.shift,y = 0.5,rot = 90)
+ grid.text(label = paste0(toupper(dim), " dimension 1"), x = 0.5, y = lab.shift)
+ grid.text(label = paste0(toupper(dim), " dimension 2"), x = lab.shift, y = 0.5, rot = 90)
}
popViewport()
# ============================================================================
# barplot
- if(isFALSE(rm.barplot)){
- pushViewport(viewport(x = unit(0.61, "npc"), y = unit(0.5, "npc"),
- width = unit(bar.width, "npc"),
- height = unit(0.7, "npc"),
- just = "left",
- yscale = c(0,nrow(cell_num) + 0.75),
- xscale = c(0,max(cell_num$n) + 0.1*max(cell_num$n))))
-
- if(rm.axis == FALSE){
+ if (isFALSE(rm.barplot)) {
+ pushViewport(
+ viewport(
+ x = unit(0.61, "npc"), y = unit(0.5, "npc"),
+ width = unit(bar.width, "npc"),
+ height = unit(0.7, "npc"),
+ just = "left",
+ yscale = c(0, nrow(cell_num) + 0.75),
+ xscale = c(0, max(cell_num$n) + 0.1 * max(cell_num$n))
+ )
+ )
+
+ if (rm.axis == FALSE) {
# grid.xaxis()
- jjPlot::grid.xaxis2(label.space = 0.5,
- at = c(0,max(cell_num$n)),
- labels = as.character(c(0,max(cell_num$n))))
+ jjPlot::grid.xaxis2(
+ label.space = 0.5,
+ at = c(0, max(cell_num$n)),
+ labels = as.character(c(0, max(cell_num$n)))
+ )
}
- grid.rect(x = rep(0,nrow(cell_num)),y = 1:nrow(cell_num),
- width = cell_num$n,height = unit(0.08,"npc"),
- just = "left",
- gp = gpar(fill = cols,col = NA),
- default.units = "native")
+ grid.rect(
+ x = rep(0, nrow(cell_num)), y = seq_len(nrow(cell_num)),
+ width = cell_num$n, height = unit(0.08, "npc"),
+ just = "left",
+ gp = gpar(fill = cols, col = NA),
+ default.units = "native"
+ )
grid.rect(gp = gpar(fill = "transparent"))
- grid.text(label = "Number of cells",x = 0.5,y = lab.shift)
+ grid.text(label = "Number of cells", x = 0.5, y = lab.shift)
popViewport()
}
# ============================================================================
# legend
- if(isTRUE(rm.barplot)){
- bar.width = 0
+ if (isTRUE(rm.barplot)) {
+ bar.width <- 0
}
- pushViewport(viewport(x = unit(0.61 + bar.width, "npc"), y = unit(0.5, "npc"),
- width = unit(0.2, "npc"),
- height = unit(0.7, "npc"),
- just = "left",
- yscale = c(0,nrow(cell_num) + 0.75)))
-
- grid.points(x = rep(0.1,nrow(cell_num)),y = 1:nrow(cell_num),pch = 19,
- gp = gpar(col = cols),size = unit(legend.psize, "char"))
- if(!is.null(cell.id)){
- grid.text(label = as.character(unlist(cell_num[,cell.id])),x = 0.1,y = 1:nrow(cell_num),
- default.units = "native")
+ pushViewport(
+ viewport(
+ x = unit(0.61 + bar.width, "npc"), y = unit(0.5, "npc"),
+ width = unit(0.2, "npc"),
+ height = unit(0.7, "npc"),
+ just = "left",
+ yscale = c(0, nrow(cell_num) + 0.75)
+ )
+ )
+
+ grid.points(
+ x = rep(0.1, nrow(cell_num)), y = seq_len(nrow(cell_num)), pch = 19,
+ gp = gpar(col = cols), size = unit(legend.psize, "char")
+ )
+ if (!is.null(cell.id)) {
+ grid.text(
+ label = as.character(unlist(cell_num[, cell.id])),
+ x = 0.1, y = seq_len(nrow(cell_num)),
+ default.units = "native"
+ )
}
- grid.text(label = cell_num$idents,x = 0.2,y = 1:nrow(cell_num),
- just = "left",
- gp = gpar(fontsize = 10),
- default.units = "native")
+ grid.text(
+ label = cell_num$idents,
+ x = 0.2, y = seq_len(nrow(cell_num)),
+ just = "left",
+ gp = gpar(fontsize = 10),
+ default.units = "native"
+ )
# grid.rect(gp = gpar(fill = "transparent"))
popViewport()
}
diff --git a/R/tracksPlot.R b/R/tracksPlot.R
index efdc404..e1273c7 100644
--- a/R/tracksPlot.R
+++ b/R/tracksPlot.R
@@ -1,10 +1,6 @@
-globalVariables(c("barcode","distinct"))
-
-#' Generate a track or heatmap plot
-#'
-#' This function generates a track or heatmap plot based on the provided data.
-#'
+#' @name tracksPlot
#' @author Jun Zhang
+#' @title This function generates a track or heatmap plot based on the provided data.
#'
#' @param object An optional object containing the data.
#' @param plot.type The type of plot to generate, either "track" or "heatmap".
@@ -20,24 +16,28 @@ globalVariables(c("barcode","distinct"))
#' @return A ggplot object representing the track or heatmap plot.
#'
#' @export
-tracksPlot <- function(object = NULL,
- plot.type = c("track","heatmap"),
- genes = NULL,
- vmin = -2,vmax = 2,
- cell.order = NULL,
- gene.order = NULL,
- facet_nested_params = list(),
- theme_params = list(),
- strip_nested_params = list()){
- plot.type <- match.arg(plot.type,c("track","heatmap"))
+
+globalVariables(c("barcode", "distinct"))
+
+tracksPlot <- function(
+ object = NULL,
+ plot.type = c("track", "heatmap"),
+ genes = NULL,
+ vmin = -2, vmax = 2,
+ cell.order = NULL,
+ gene.order = NULL,
+ facet_nested_params = list(),
+ theme_params = list(),
+ strip_nested_params = list()) {
+ plot.type <- match.arg(plot.type, c("track", "heatmap"))
# check markers gene
- if(is.data.frame(genes)){
+ if (is.data.frame(genes)) {
markers_tmp <- genes |> dplyr::mutate(gene = make.unique(gene))
markers <- markers_tmp$gene
names(markers) <- markers_tmp$cluster
- }else{
+ } else {
markers <- genes
}
@@ -47,44 +47,46 @@ tracksPlot <- function(object = NULL,
colnames(barcode_info)[1] <- "cell"
# get normalized matrix
- df <- data.frame(t(as.matrix(object@assays$RNA@data)),check.names = F)[,markers]
+ df <- data.frame(t(as.matrix(object@assays$RNA@data)), check.names = FALSE)[, markers]
# do zscore
- if(plot.type == "heatmap"){
- df <- scale(df,center = T) |> data.frame(check.names = F)
- df <- apply(df, c(1,2), function(x){
- if(x > vmax){
- x = vmax
- }else if(x < vmin){
- x = vmin
- }else{
+ if (plot.type == "heatmap") {
+ df <- scale(df, center = TRUE) |>
+ data.frame(check.names = FALSE)
+ df <- apply(df, c(1, 2), function(x) {
+ if (x > vmax) {
+ x <- vmax
+ } else if (x < vmin) {
+ x <- vmin
+ } else {
x
}
- }) |> data.frame(check.names = F)
+ }) |>
+ data.frame(check.names = FALSE)
}
df$barcode <- rownames(df)
# add cell type
df <- df |>
- dplyr::left_join(y = barcode_info,by = "barcode")
+ dplyr::left_join(y = barcode_info, by = "barcode")
# wide to long
- df_long <- reshape2::melt(df,id.vars = c("cell","barcode"))
- colnames(df_long)[3:4] <- c("gene","exp")
+ df_long <- reshape2::melt(df, id.vars = c("cell", "barcode"))
+ colnames(df_long)[3:4] <- c("gene", "exp")
# order
- if(!is.null(cell.order)){
- df_long$cell <- factor(df_long$cell,levels = cell.order)
+ if (!is.null(cell.order)) {
+ df_long$cell <- factor(df_long$cell, levels = cell.order)
}
- if(!is.null(gene.order)){
- df_long$gene <- factor(df_long$gene,levels = gene.order)
+ if (!is.null(gene.order)) {
+ df_long$gene <- factor(df_long$gene, levels = gene.order)
}
# whether add cluster
- if(is.data.frame(genes)){
- plyr::ldply(seq_along(markers),function(x){
+ if (is.data.frame(genes)) {
+ plyr::ldply(seq_along(markers), function(x) {
df_tmp <- df_long |>
dplyr::filter(gene == markers[x]) |>
dplyr::mutate(cluster = names(markers[x]))
@@ -97,58 +99,85 @@ tracksPlot <- function(object = NULL,
# plot
# ============================================================================
# strip color
- strip <- do.call(ggh4x::strip_nested,modifyList(list(),
- strip_nested_params))
+ strip <- do.call(ggh4x::strip_nested, modifyList(
+ list(),
+ strip_nested_params
+ ))
# facet layer
- if(is.data.frame(genes)){
+ if (is.data.frame(genes)) {
facet_nested <-
- do.call(ggh4x::facet_nested,modifyList(list(cluster+gene~cell,
- scales = "free",
- space = "fixed",
- switch = "y",
- nest_line = ggplot2::element_line(),
- strip = strip),
- facet_nested_params))
- }else{
+ do.call(
+ ggh4x::facet_nested, modifyList(
+ list(cluster + gene ~ cell,
+ scales = "free",
+ space = "fixed",
+ switch = "y",
+ nest_line = ggplot2::element_line(),
+ strip = strip
+ ),
+ facet_nested_params
+ )
+ )
+ } else {
facet_nested <-
- do.call(ggh4x::facet_nested,modifyList(list(gene~cell,
- scales = "free",
- space = "fixed",
- switch = "y",
- nest_line = ggplot2::element_line(),
- strip = strip),
- facet_nested_params))
+ do.call(
+ ggh4x::facet_nested, modifyList(
+ list(gene ~ cell,
+ scales = "free",
+ space = "fixed",
+ switch = "y",
+ nest_line = ggplot2::element_line(),
+ strip = strip
+ ),
+ facet_nested_params
+ )
+ )
}
# main layer
- pmain <-
- ggplot2::ggplot(df_long) +
+ pmain <- ggplot2::ggplot(df_long) +
ggplot2::theme_bw(base_size = 12) +
facet_nested +
- # do.call(facet_grid,modifyList(list(gene~cell,
- # scales = "free",space = "fixed",switch = "y"),
- # facet_grid_params)) +
- do.call(ggplot2::theme,modifyList(list(axis.text = ggplot2::element_blank(),
- axis.ticks = ggplot2::element_blank(),
- panel.grid = ggplot2::element_blank(),
- strip.placement = "outside",
- strip.background.y = ggplot2::element_blank(),
- strip.text = ggplot2::element_text(face = "bold.italic"),
- strip.text.y.left = ggplot2::element_text(angle = 0,hjust = 1)),
- theme_params)) +
- ggplot2::xlab("") + ggplot2::ylab("")
+ # do.call(
+ # facet_grid, modifyList(
+ # list(
+ # gene~cell,
+ # scales = "free",
+ # space = "fixed",switch = "y"
+ # ),
+ # facet_grid_params
+ # )
+ # ) +
+ do.call(
+ ggplot2::theme, modifyList(
+ list(
+ axis.text = ggplot2::element_blank(),
+ axis.ticks = ggplot2::element_blank(),
+ panel.grid = ggplot2::element_blank(),
+ strip.placement = "outside",
+ strip.background.y = ggplot2::element_blank(),
+ strip.text = ggplot2::element_text(face = "bold.italic"),
+ strip.text.y.left = ggplot2::element_text(angle = 0, hjust = 1)
+ ),
+ theme_params
+ )
+ ) +
+ ggplot2::xlab("") +
+ ggplot2::ylab("")
# add layers
- if(plot.type == "heatmap"){
+ if (plot.type == "heatmap") {
p <- pmain +
- ggplot2::geom_tile(ggplot2::aes(x = barcode,y = gene,fill = exp)) +
+ ggplot2::geom_tile(ggplot2::aes(x = barcode, y = gene, fill = exp)) +
ggplot2::coord_cartesian(expand = 0) +
- ggplot2::scale_fill_gradient2(low = "#313695",mid = "white",high = "#A50026",
- midpoint = 0,na.value = "white")
- }else{
+ ggplot2::scale_fill_gradient2(
+ low = "#313695", mid = "white", high = "#A50026",
+ midpoint = 0, na.value = "white"
+ )
+ } else {
p <- pmain +
- ggplot2::geom_col(ggplot2::aes(x = barcode,y = exp,fill = gene),width = 1)
+ ggplot2::geom_col(ggplot2::aes(x = barcode, y = exp, fill = gene), width = 1)
}
return(p)
diff --git a/README.md b/README.md
index cf15d28..edc407f 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,8 @@
# scRNAtoolVis 
+
Some useful function to make your scRNA-seq plot more beautiful.
-
- ## Installation
+
+## Installation
```R
install.packages('devtools')
@@ -15,10 +16,11 @@ library(scRNAtoolVis)
## Citation
-> Jun Zhang (2022). *scRNAtoolVis: Useful Functions to Make Your scRNA-seq Plot More Cool!.* https://github.com/junjunlab/scRNAtoolVis, https://junjunlab.github.io/scRNAtoolVis-manual/.
+> Jun Zhang (2022). *scRNAtoolVis: Useful Functions to Make Your scRNA-seq Plot More Cool!.* , .
## More examples see
-> - https://junjunlab.github.io/scRNAtoolVis-manual/
+>
+> -
@@ -29,10 +31,10 @@ library(scRNAtoolVis)
> - [**scRNAtoolVis 0.0.3 版本更新**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247501432&idx=1&sn=93a7bb3506c911845ef7d10a2fcfdea3&chksm=c184fc09f6f3751f0c2b94f0a6d69692efcc916a45a5409f93b23f90f8db809ca750f87ba234&token=1253522169&lang=zh_CN#rd)
> - [**jjDotPlot 优雅的可视化单细胞基因表达**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247505159&idx=1&sn=e81b7f890e93419be154b1cf432ae84f&chksm=c184ef76f6f366608d6b2b2d214aecaa4d6c57e976f9fe43a93201a3f6795051395ffc2addf4&token=1253522169&lang=zh_CN#rd)
> - [**jjDotPlot 对基因和亚群排序**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247505344&idx=1&sn=40b5934ca798e6518172b6c5743c9d95&chksm=c184efb1f6f366a7db3d924f54e9e763c78366021a6d263a502f4d4f4a806250743a74283d5f&token=1253522169&lang=zh_CN#rd)
-> - [**AverageHeatmap 调整细胞亚群顺序**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247505603&idx=1&sn=3f85e23cc0eaffa5d92fb4aa03ca0d14&chksm=c184ecb2f6f365a41a428f5600fa9797263bb4432d51be7dc452f213bc1c9be70d50ab669159&token=1253522169&lang=zh_CN#rd)
+> - [**averageHeatmap 调整细胞亚群顺序**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247505603&idx=1&sn=3f85e23cc0eaffa5d92fb4aa03ca0d14&chksm=c184ecb2f6f365a41a428f5600fa9797263bb4432d51be7dc452f213bc1c9be70d50ab669159&token=1253522169&lang=zh_CN#rd)
> - [**jjVolcano 一行代码绘制单细胞火山图**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247506316&idx=1&sn=307fffe550e25987b148f843e169cbcd&chksm=c184e3fdf6f36aebbe7e948d029f831f03c2906e02a271ee85900a2faac262d2c80bd1b7d2b5&token=1253522169&lang=zh_CN#rd)
> - [**单细胞火山图的旋转和环形**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247506337&idx=1&sn=5d84b4cbddf053456561d806f3d04737&chksm=c184e3d0f6f36ac65a1cee3d353de3715c30460af0acfbc35446eac61b5b5e9170d7fb1e6315&token=1253522169&lang=zh_CN#rd)
-> - [**AverageHeatmap 对单细胞 marker 基因聚类**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247506807&idx=1&sn=f649c782a8d21765f185f03dec0fd9c5&chksm=c184e106f6f3681003142cbb48c5bc406da8458e0153bd00e805ae8fb9c01c6b25c6ff4d6156&token=1253522169&lang=zh_CN#rd)
+> - [**averageHeatmap 对单细胞 marker 基因聚类**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247506807&idx=1&sn=f649c782a8d21765f185f03dec0fd9c5&chksm=c184e106f6f3681003142cbb48c5bc406da8458e0153bd00e805ae8fb9c01c6b25c6ff4d6156&token=1253522169&lang=zh_CN#rd)
> - [**听说你想绘制 scanpy 的 tracksPlot?**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247509478&idx=1&sn=71977a66e74d9dc4fa6aa1b2adbc50be&chksm=c1849f97f6f31681543b475f4df381c9e462dfd617260d5fbeb8956731033c97eb4c20a49f9b&token=143921488&lang=zh_CN#rd)
> - [**用 grid 手搓一个单细胞散点图+细胞数量条形图**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247509735&idx=1&sn=212e45f9e6c8cfd13bc943b6ac806dc2&chksm=c1849c96f6f31580624e0d4bab65b47d7b3e4cf7fc604881fb9c27a32249bd071dd1eae20d66&token=868587677&lang=zh_CN#rd)
> - [**听说你要绘制 scanpy 版的散点图?**](https://mp.weixin.qq.com/s?__biz=MzkyMTI1MTYxNA==&mid=2247509799&idx=1&sn=b3bc4bbbb8c1e3a98be3f5815cbcb4f0&chksm=c1849d56f6f3144000e22d4b9ebf989ad79349c450928c2a2346749b0187d857fca15d9e7183&token=613129250&lang=zh_CN#rd)
diff --git a/man/AverageHeatmap.Rd b/man/AverageHeatmap.Rd
index c4d34b2..544b6da 100644
--- a/man/AverageHeatmap.Rd
+++ b/man/AverageHeatmap.Rd
@@ -1,10 +1,10 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/AverageHeatmap.R
-\name{AverageHeatmap}
-\alias{AverageHeatmap}
+% Please edit documentation in R/averageHeatmap.R
+\name{averageHeatmap}
+\alias{averageHeatmap}
\title{Plot averaged gene expression cross cluster cells}
\usage{
-AverageHeatmap(
+averageHeatmap(
object = NULL,
markerGene = NULL,
group.by = "ident",
@@ -39,25 +39,25 @@ AverageHeatmap(
\item{markerGene}{Your marker genes.}
-\item{group.by}{Categories for grouping (e.g, ident, replicate, celltype). 'ident' by default.}
+\item{group.by}{Categories for grouping (e.g, ident, replicate, celltype). "ident" by default.}
\item{assays}{Which assays to use. Default is "RNA" assays.}
-\item{slot}{Slot(s) to use. Default is "data"}
+\item{slot}{Slot(s) to use. Default is "data".}
\item{htCol}{Heatmap colors. Default is c("#0099CC", "white", "#CC0033").}
-\item{colseed}{Cluster annotaion colors seed, these colors are produed randomly, so you can give a seed to assure produce same colors. Default is 666.}
+\item{colseed}{Cluster annotation colors seed, these colors are produced randomly, so you can give a seed to assure produce same colors. Default is 666.}
\item{htRange}{Heatmap values range. Default is c(-2, 0, 2).}
-\item{annoCol}{Whether use your own annotation clusters colors. Default is 'FALSE'.}
+\item{annoCol}{Whether use your own annotation clusters colors. Default is "FALSE".}
-\item{myanCol}{You can specify your own annotation clusters colors vectors. Default is 'null'.}
+\item{myanCol}{You can specify your own annotation clusters colors vectors. Default is "null".}
-\item{annoColType}{Cluster annotaion colors type (bright, light, dark and random). Default is light.}
+\item{annoColType}{Cluster annotation colors type (bright, light, dark and random). Default is light.}
-\item{annoColTypeAlpha}{Cluster annotaion colors transparency. Default is 0.}
+\item{annoColTypeAlpha}{Cluster annotation colors transparency. Default is 0.}
\item{row_title}{Heatmap row title. Default is "Cluster top Marker genes".}
@@ -104,13 +104,13 @@ markergene <- system.file("extdata", "top5pbmc.markers.csv", package = "scRNAtoo
markers <- read.table(markergene, sep = ",", header = TRUE)
# plot
-AverageHeatmap(
+averageHeatmap(
object = pbmc,
markerGene = markers$gene
)
# change color
-AverageHeatmap(
+averageHeatmap(
object = pbmc,
markerGene = markers$gene,
htCol = c("#339933", "#FFCC00", "#FF0033")
diff --git a/man/FeatureCornerAxes.Rd b/man/FeatureCornerAxes.Rd
index 57e4198..d1bb1d3 100644
--- a/man/FeatureCornerAxes.Rd
+++ b/man/FeatureCornerAxes.Rd
@@ -1,44 +1,44 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/FeatureCornerAxes.R
-\name{FeatureCornerAxes}
-\alias{FeatureCornerAxes}
+% Please edit documentation in R/featureCornerAxes.R
+\name{featureCornerAxes}
+\alias{featureCornerAxes}
\title{Add corner axes on seurat UMAP/tSNE gene FeaturePlot function figures}
\arguments{
\item{object}{object seurat object.}
-\item{reduction}{"string",reduction type (umap/tsne).}
+\item{reduction}{"string", reduction type (umap/tsne).}
-\item{features}{"string",the gene you want to plot.}
+\item{features}{"string", the gene you want to plot.}
-\item{groupFacet}{"string",give the column name in seurat metadata to facet plot, if it is "NULL", facet plot only by gene.}
+\item{groupFacet}{"string", give the column name in seurat metadata to facet plot, if it is "NULL", facet plot only by gene.}
-\item{relLength}{"num",the corner axis line relative length to plot axis(0-1).}
+\item{relLength}{"num", the corner axis line relative length to plot axis(0-1).}
-\item{relDist}{"num",the relative distance of corner axis label to axis.}
+\item{relDist}{"num", the relative distance of corner axis label to axis.}
\item{aspect.ratio}{"num", plot width and height ratio, default NULL.}
-\item{low}{"string",point color with low expression.}
+\item{low}{"string", point color with low expression.}
-\item{high}{"string",point color with high expression.}
+\item{high}{"string", point color with high expression.}
-\item{axes}{"string",show multiple corner axis or only one (mul/one), default "mul".}
+\item{axes}{"string", show multiple corner axis or only one (mul/one), default "mul".}
-\item{legendPos}{"string",legend position same as ggplot theme function, default "right".}
+\item{legendPos}{"string", legend position same as ggplot theme function, default "right".}
-\item{stripCol}{"string",facet balckground color, defaults "white".}
+\item{stripCol}{"string", facet background color, defaults "white".}
-\item{pSize}{"num",point size.}
+\item{pSize}{"num", point size.}
-\item{arrowType}{"string",arrow type (open/closed), default "closed".}
+\item{arrowType}{"string", arrow type (open/closed), default "closed".}
-\item{lineTextcol}{"string",facet balckground color, default "white".}
+\item{lineTextcol}{"string", facet background color, default "white".}
\item{cornerTextSize}{"num", the corner label text size, default is 5.}
\item{base_size}{"num", theme base size, default is 14.}
-\item{themebg}{Another theme style, default is 'default', or 'bwCorner'.}
+\item{themebg}{Another theme style, default is "default", or "bwCorner".}
\item{show.legend}{Whether show legend, default "TRUE".}
@@ -63,7 +63,7 @@ test <- system.file("extdata", "seuratTest.RDS", package = "scRNAtoolVis")
tmp <- readRDS(test)
# umap
-FeatureCornerAxes(
+featureCornerAxes(
object = tmp, reduction = "umap",
groupFacet = "orig.ident",
relLength = 0.5, relDist = 0.2,
@@ -71,7 +71,7 @@ FeatureCornerAxes(
)
# one axes
-FeatureCornerAxes(
+featureCornerAxes(
object = tmp, reduction = "umap",
groupFacet = "orig.ident",
features = c("Actb", "Ythdc1", "Ythdf2"),
@@ -81,7 +81,7 @@ FeatureCornerAxes(
)
# tsne
-FeatureCornerAxes(
+featureCornerAxes(
object = tmp, reduction = "tsne",
groupFacet = "orig.ident",
relLength = 0.5, relDist = 0.2,
diff --git a/man/clusterCornerAxes.Rd b/man/clusterCornerAxes.Rd
index 6178fef..34f02a3 100644
--- a/man/clusterCornerAxes.Rd
+++ b/man/clusterCornerAxes.Rd
@@ -16,11 +16,11 @@
\item{aspect.ratio}{"num", plot width and height ratio, default NULL.}
-\item{noSplit}{'logic', whether to split/facet the plot, default "TRUE".}
+\item{noSplit}{"logic", whether to split/facet the plot, default "TRUE".}
\item{nrow}{"num", rows to plot when noSplit = FALSE.}
-\item{relLength}{'num', the corner axis line relative length to plot axis(0-1).}
+\item{relLength}{"num", the corner axis line relative length to plot axis(0-1).}
\item{relDist}{"num" ,the relative distance of corner axis label to axis.}
@@ -32,7 +32,7 @@
\item{lineTextcol}{"string", corner line and label color, default "black".}
-\item{stripCol}{"string", facet balckground color, default "white".}
+\item{stripCol}{"string", facet background color, default "white".}
\item{arrowType}{"string", arrow type (open/closed), default "closed".}
@@ -40,17 +40,21 @@
\item{base_size}{"num", theme base size, default is 14.}
-\item{themebg}{Another theme style, default is 'default', or 'bwCorner'.}
+\item{themebg}{Another theme style, default is "default", or "bwCorner".}
-\item{addCircle}{Logic, whether add circle on clusters, default is 'FALSE'.}
+\item{addCircle}{"logic", whether add circle on clusters, default is "FALSE".}
-\item{cicAlpha}{"num", circle fill color alpha, default is 0.1,}
+\item{addCircle.legacy}{"logic", using the legacy version to add a circle, the parameters \code{nbin}, \code{nsm}, \code{addsm}, \code{sfac} and \code{qval} are only applicable to legacy, default is "FALSE".}
+
+\item{cicAlpha}{"num", circle fill color alpha, default is 0.1.}
+
+\item{cicDelta}{"num", the distance to extend the curve (circle), this parameter only takes effect when \code{addCircle.legacy = FALSE}.}
\item{cicLineSize}{"num", circle line size, default is 1.}
-\item{cicLineColor}{"num", circle line color, default is 'grey50'.}
+\item{cicLineColor}{"num", circle line color, default is "grey50".}
-\item{cicLineLty}{"num", circle line type, default is 'dashed'.}
+\item{cicLineLty}{"num", circle line type, default is "dashed".}
\item{nbin}{"num", number of points used to shape the hull, default 100.}
@@ -66,9 +70,9 @@
\item{cellLabelSize}{Cell type label size, default is 6.}
-\item{cellLabelColor}{Cell type label color, default is "balck".}
+\item{cellLabelColor}{Cell type label color, default is "black".}
-\item{show.legend}{Wheher show legend, default is TRUE.}
+\item{show.legend}{Whether show legend, default is TRUE.}
}
\value{
Return a ggplot object.
diff --git a/man/featurePlot.Rd b/man/featurePlot.Rd
index 5e7948b..0428a6a 100644
--- a/man/featurePlot.Rd
+++ b/man/featurePlot.Rd
@@ -2,32 +2,8 @@
% Please edit documentation in R/featurePlot.R
\name{featurePlot}
\alias{featurePlot}
-\title{featurePlot Function}
-\usage{
-featurePlot(
- object = NULL,
- dim = "umap",
- genes = NULL,
- nrow = NULL,
- ncol = NULL,
- quantile.val = 1,
- color = NULL,
- rm.axis = FALSE,
- rm.legend = FALSE,
- add.rect = FALSE,
- add.corArrow = FALSE,
- add.strip = FALSE,
- corLabel.dist = 0.08,
- arrow.len = 0.2,
- arrow.label.size = 6,
- plot.size = 0.6,
- keep.oneCor = FALSE,
- xlab = NULL,
- ylab = NULL,
- respect = TRUE,
- point.size = 1
-)
-}
+\title{This function creates a scatter plot for multiple genes or features from a
+Seurat object.}
\arguments{
\item{object}{A Seurat object containing the data.}
@@ -85,7 +61,7 @@ Seurat object.
}
\examples{
\dontrun{
-# Assuming 'seurat_obj' is a Seurat object
+# Assuming "seurat_obj" is a Seurat object
featurePlot(object = seurat_obj, genes = c("gene1", "gene2", "gene3"), nrow = 2, ncol = 2)
}
diff --git a/man/jjDotPlot.Rd b/man/jjDotPlot.Rd
index 1139a3d..c912504 100644
--- a/man/jjDotPlot.Rd
+++ b/man/jjDotPlot.Rd
@@ -16,9 +16,9 @@
\item{split.by.aesGroup}{whether the dot color filled by group, default FALSE.}
-\item{gene}{the genes to be drawed in plot, default NULL.}
+\item{gene}{the genes to be drawn in plot, default NULL.}
-\item{markerGene}{the marker genes with celltype info to be drawed, default NULL.}
+\item{markerGene}{the marker genes with celltype info to be drawn, default NULL.}
\item{point.geom}{the ggplot "point" geom layer to be shown, default TRUE.}
@@ -86,7 +86,7 @@
\item{bar.legendTitle}{colorbar legend title, default "Mean expression in group".}
-\item{point.lengdTitle}{point size legend title, default "Fraction of cells in group (\%)".}
+\item{point.legendTitle}{point size legend title, default "Fraction of cells in group (\%)".}
\item{...}{other parameters passed to annoSegment function.}
@@ -106,7 +106,7 @@ httest <- system.file("extdata", "htdata.RDS", package = "scRNAtoolVis")
pbmc <- readRDS(httest)
# add groups
-pbmc$groups <- rep(c('stim','control'),each = 1319)
+pbmc$groups <- rep(c("stim", "control"), each = 1319)
# add celltype
pbmc$celltype <- Seurat::Idents(pbmc)
@@ -114,25 +114,35 @@ pbmc$celltype <- Seurat::Idents(pbmc)
markergene <- data("top3pbmc.markers")
# ====================================
-jjDotPlot(object = pbmc,
- gene = top3pbmc.markers$gene)
-
-jjDotPlot(object = pbmc,
- gene = top3pbmc.markers$gene,
- id = 'celltype')
-
-jjDotPlot(object = pbmc,
- markerGene = top3pbmc.markers)
-
-jjDotPlot(object = pbmc,
- markerGene = top3pbmc.markers,
- xtree = TRUE)
-
-jjDotPlot(object = pbmc,
- markerGene = top3pbmc.markers,
- anno = TRUE,
- plot.margin = c(3,1,1,1))
- }
+jjDotPlot(
+ object = pbmc,
+ gene = top3pbmc.markers$gene
+)
+
+jjDotPlot(
+ object = pbmc,
+ gene = top3pbmc.markers$gene,
+ id = "celltype"
+)
+
+jjDotPlot(
+ object = pbmc,
+ markerGene = top3pbmc.markers
+)
+
+jjDotPlot(
+ object = pbmc,
+ markerGene = top3pbmc.markers,
+ xtree = TRUE
+)
+
+jjDotPlot(
+ object = pbmc,
+ markerGene = top3pbmc.markers,
+ anno = TRUE,
+ plot.margin = c(3, 1, 1, 1)
+)
+}
}
\author{
Junjun Lao
diff --git a/man/jjVolcano.Rd b/man/jjVolcano.Rd
index f2c81b2..c145109 100644
--- a/man/jjVolcano.Rd
+++ b/man/jjVolcano.Rd
@@ -12,17 +12,17 @@
\item{pvalue.cutoff}{pvalue cutoff to filter, default 0.05.}
-\item{adjustP.cutoff}{ajusted pvalue cutoff to be colored in plot, default 0.01.}
+\item{adjustP.cutoff}{adjusted pvalue cutoff to be colored in plot, default 0.01.}
\item{topGeneN}{top genes to be labeled in plot, default 5.}
-\item{col.type}{point color type('updown/adjustP'), default "updown".}
+\item{col.type}{point color type("updown/adjustP"), default "updown".}
\item{back.col}{background color, default "grey93".}
\item{pSize}{point size, default 0.75.}
-\item{aesCol}{point mapping color, default c('#0099CC','#CC3333').}
+\item{aesCol}{point mapping color, default c("#0099CC","#CC3333").}
\item{legend.position}{legend position in plot, default c(0.7,0.9).}
@@ -34,11 +34,11 @@
\item{cluster.order}{whether given your cluster orders, default NULL.}
-\item{polar}{whether make the plot to br polar, default FASLE.}
+\item{polar}{whether make the plot to br polar, default FALSE.}
\item{expand}{the y axis expand, default c(-1,1).}
-\item{flip}{whether flip the plot, default FASLE.}
+\item{flip}{whether flip the plot, default FALSE.}
\item{order.by}{top marker gene selection method, how the order is, default c("avg_log2FC").}
}
@@ -49,7 +49,9 @@ a ggplot object.
using jjVolcano to visualize marker genes
}
\examples{
-\dontrun{jjVolcano(diffData = pbmc.markers)}
+\dontrun{
+jjVolcano(diffData = pbmc.markers)
+}
}
\author{
Junjun Lao
diff --git a/man/markerVocalno.Rd b/man/markerVolcano.Rd
similarity index 51%
rename from man/markerVocalno.Rd
rename to man/markerVolcano.Rd
index b101e89..6e059a2 100644
--- a/man/markerVocalno.Rd
+++ b/man/markerVolcano.Rd
@@ -1,8 +1,8 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/markerVocalno.R
-\name{markerVocalno}
-\alias{markerVocalno}
-\title{Marker genes vocalno plot}
+% Please edit documentation in R/markerVolcano.R
+\name{markerVolcano}
+\alias{markerVolcano}
+\title{Marker genes volcano plot}
\arguments{
\item{markers}{Dataframe marker genes from findAllmarkers function from seurat.}
@@ -14,25 +14,25 @@
\item{hlineSize}{Hline size, defaults is 1.}
-\item{hlineColor}{Hline color, defaults is 'grey50'.}
+\item{hlineColor}{Hline color, defaults is "grey50".}
\item{pforce}{Positive gene force parameters to avoid overlap gene labels, defaults is 5.}
-\item{nforce}{Negtive gene force parameters to avoid overlap gene labels, defaults is 2.5.}
+\item{nforce}{Negative gene force parameters to avoid overlap gene labels, defaults is 2.5.}
-\item{nudge_x}{Ajustments on the horizotal of the gene label, defaults is 0.8.}
+\item{nudge_x}{Adjustments on the horizontal of the gene label, defaults is 0.8.}
-\item{pnudge_y}{Ajustments on the horizotal of the positive gene label, defaults is 0.25.}
+\item{pnudge_y}{Adjustments on the horizontal of the positive gene label, defaults is 0.25.}
-\item{nnudge_y}{Ajustments on the horizotal of the negtive gene label, defaults is 0.}
+\item{nnudge_y}{Adjustments on the horizontal of the negative gene label, defaults is 0.}
\item{base_size}{Theme base size, defaults is 14.}
\item{facetColor}{Facet border color, defaults is NA.}
-\item{facetFill}{Facet fill color, defaults is 'white'.}
+\item{facetFill}{Facet fill color, defaults is "white".}
-\item{ylab}{Plot y label, defaults is 'Log2-Fold Change'.}
+\item{ylab}{Plot y label, defaults is "Log2-Fold Change".}
\item{nrow}{Numbers rows to plot, defaults is 1.}
}
@@ -40,15 +40,17 @@
Return a ggplot.
}
\description{
-Marker genes vocalno plot
+Marker genes volcano plot
}
\examples{
test <- system.file("extdata", "pbmc.markers.csv", package = "scRNAtoolVis")
markers <- read.csv(test)
-markerVocalno(markers = markers,
- topn = 5,
- labelCol = ggsci::pal_npg()(9))
+markerVolcano(
+ markers = markers,
+ topn = 5,
+ labelCol = ggsci::pal_npg()(9)
+)
}
\author{
Junjun Lao
diff --git a/man/pbmc.markers.Rd b/man/pbmc.markers.Rd
index af29ae9..27d338c 100644
--- a/man/pbmc.markers.Rd
+++ b/man/pbmc.markers.Rd
@@ -4,7 +4,7 @@
\name{pbmc.markers}
\alias{pbmc.markers}
\title{This is a test data for this package
-test data describtion}
+test data description}
\format{
An object of class \code{data.frame} with 5921 rows and 7 columns.
}
@@ -13,7 +13,7 @@ pbmc.markers
}
\description{
This is a test data for this package
-test data describtion
+test data description
}
\author{
Junjun Lao
diff --git a/man/scatterCellPlot.Rd b/man/scatterCellPlot.Rd
index a53290d..c135003 100644
--- a/man/scatterCellPlot.Rd
+++ b/man/scatterCellPlot.Rd
@@ -2,21 +2,7 @@
% Please edit documentation in R/scatterCellPlot.R
\name{scatterCellPlot}
\alias{scatterCellPlot}
-\title{Scatter Cell Plot}
-\usage{
-scatterCellPlot(
- object = NULL,
- color = NULL,
- dim = "umap",
- rm.axis = FALSE,
- cell.id = NULL,
- bar.width = 0.2,
- point.size = 1,
- rm.barplot = FALSE,
- legend.psize = 1.5,
- arrow.len = 0.2
-)
-}
+\title{This function creates a scatter cell plot using the grid package in R.}
\arguments{
\item{object}{A Seurat object containing the data.}
@@ -45,7 +31,9 @@ None
This function creates a scatter cell plot using the grid package in R.
}
\examples{
-\dontrun{scatterCellPlot(object = seurat_object)}
+\dontrun{
+scatterCellPlot(object = seurat_object)
+}
}
\author{
diff --git a/man/top3pbmc.markers.Rd b/man/top3pbmc.markers.Rd
index a6da781..6a21c9f 100644
--- a/man/top3pbmc.markers.Rd
+++ b/man/top3pbmc.markers.Rd
@@ -4,7 +4,7 @@
\name{top3pbmc.markers}
\alias{top3pbmc.markers}
\title{This is a test data for this package
-test data describtion}
+test data description}
\format{
An object of class \code{grouped_df} (inherits from \code{tbl_df}, \code{tbl}, \code{data.frame}) with 27 rows and 7 columns.
}
@@ -13,7 +13,7 @@ top3pbmc.markers
}
\description{
This is a test data for this package
-test data describtion
+test data description
}
\author{
Junjun Lao
diff --git a/man/tracksPlot.Rd b/man/tracksPlot.Rd
index 2cd067b..261e9ed 100644
--- a/man/tracksPlot.Rd
+++ b/man/tracksPlot.Rd
@@ -2,21 +2,7 @@
% Please edit documentation in R/tracksPlot.R
\name{tracksPlot}
\alias{tracksPlot}
-\title{Generate a track or heatmap plot}
-\usage{
-tracksPlot(
- object = NULL,
- plot.type = c("track", "heatmap"),
- genes = NULL,
- vmin = -2,
- vmax = 2,
- cell.order = NULL,
- gene.order = NULL,
- facet_nested_params = list(),
- theme_params = list(),
- strip_nested_params = list()
-)
-}
+\title{This function generates a track or heatmap plot based on the provided data.}
\arguments{
\item{object}{An optional object containing the data.}