initial commit

Package: plot1cell

Title: A package for single cell data visualization

Version: 0.0.0.9000

Authors@R: 

    person(given = "Haojia",

           family = "Wu",

           role = c("aut", "cre"),

           email = "haojiawu@wustl.edu",

           comment = c(ORCID = "0000-0002-7866-2544"))

Description: This package allows users to visualize the single cell data on the R objects or output files generated by the popular tools such as Seurat, SCENIC, monocle, CellPhoneDB, CellChat etc.  

Imports:

    Seurat,

    plotly,

    circlize,

    dplyr,

    ggplot2,

    MASS,

    scales,

    progress,

    RColorBrewer,

    grid,

    grDevices,

    biomaRt,

    reshape2,

    ggbeeswarm,

    purrr,

    UpSetR,

    matrixStats,

    DoubletFinder,

    methods,

    data.table,

    Matrix,

    hdf5r,

    loomR,

    Signac,

    GenomeInfoDb,

    EnsDb.Hsapiens.v86,

    cowplot,

    rlang

Depends:

    Seurat,

    plotly,

    circlize,

    dplyr,

    ggplot2,

    MASS,

    scales,

    progress,

    RColorBrewer,

    grid,

    grDevices,

    biomaRt,

    reshape2,

    ggbeeswarm,

    purrr,

    UpSetR,

    matrixStats,

    DoubletFinder,

    methods,

    data.table,

    Matrix,

    hdf5r,

    loomR,

    Signac,

    GenomeInfoDb,

    EnsDb.Hsapiens.v86,

    cowplot,

    rlang

License: GPL-3 

Encoding: UTF-8

LazyData: true

Roxygen: list(markdown = TRUE)

RoxygenNote: 7.1.2

Suggests: 

    rmarkdown,

    knitr

VignetteBuilder: knitr

# Generated by roxygen2: do not edit by hand

export(add_sliding_windows)

export(add_tract)

export(cell_order)

export(convert_geneid)

export(creat_cellphonedb_file)

export(create_pyscenic_file)

export(data_processing)

export(get_metadata)

export(get_segment)

export(mk_color_table)

export(mk_marker_ct)

export(modified_coverageplot)

export(modified_dimplot)

export(modified_dotplot)

export(plot_circlize)

export(plot_multigene_group)

export(plot_qpcr)

export(plot_singlegene_group)

export(plot_upset)

export(prepare_circlize_data)

export(run_correlation)

export(transform_coordinates)

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Functions

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#' Modified CoveragePlot

#'

#' This function is a modified version of the CoveragePlot in Signac that allows gene name input and group splitting

#'

#' @param sig_obj A complete Signac object

#' @param gene Gene name

#' @param slide_windows_up Upper range of the slide window

#' @param slide_windows_down Lower range of the slide window

#' @param split_by Group ID in metadata to split peaks

#' @return A ggplot object

#' @export

modified_coverageplot <- function(

  sig_obj, 

  gene, 

  slide_windows_up, 

  slide_windows_down,

  split_by

){

  celltypes<-levels(sig_obj)

  DefaultAssay(sig_obj)<-'peaks'

  sig_obj@meta.data$disease<-sig_obj@meta.data[,split_by]

  sig_obj@meta.data$celltype<-sig_obj@active.ident

  sig_obj@meta.data$id2<-paste(sig_obj@meta.data$celltype,sig_obj@meta.data$disease,  sep = "_")

  sig_obj<- SetIdent(sig_obj, value = 'id2')

  p2 <- Signac::CoveragePlot(

    object = sig_obj,

    region = gene,

    annotation = T,

    peaks = T, 

    extend.upstream = slide_windows_up,

    extend.downstream = slide_windows_down

  )

  gene.ranges <- genes(EnsDb.Hsapiens.v86)

  seqlevelsStyle(gene.ranges) <- 'UCSC'

  gene.ranges <- keepStandardChromosomes(gene.ranges, pruning.mode = 'coarse')

  region2 <- GRangesToString(subset(gene.ranges, symbol==gene))

  if(region2=='--') {

    next

  }

  if(length(region2)>1){

    region2<-region2[1]

  }

  region2<-add_sliding_windows(region = region2, up_stream = slide_windows_up, down_stream = slide_windows_down)

  xlabel<-p2$patches$plots[1][[1]]$labels$x

  ylabel<-p2$patches$plots[1][[1]]$labels$y

  data_plot<-p2$patches$plots[1][[1]]$data

  data_plot$celltype<-gsub("_[^_]*$", "", data_plot$group )

  data_plot$disease<-gsub(".*_", "", data_plot$group )

  data_plot$celltype <- factor(data_plot$celltype, levels = celltypes)

  a1<-Signac:::PeakPlot(sig_obj,region = region2)

  a2<-p2$patches$plots[2][[1]]

  group_id<-names(table(data_plot$disease))

  a3 <- ggplot(

    data = data_plot[data_plot$disease==group_id[1],],

    mapping = aes(x = position, y = coverage, fill = celltype)

  ) +

    geom_area(stat = "identity") +

    geom_hline(yintercept = 0, size = 0.1) +

    xlab("")+ylab(as_string(ylabel))+ggtitle(group_id[1])+

    theme_browser(legend = FALSE) +

    facet_grid(celltype ~.)+

    theme(

      panel.spacing.y = unit(x = 0, units = "line"),

      plot.title = element_text(size = 14,hjust = 0.5, face = 'bold'),

      strip.text.y = element_text(angle = 0),

      axis.ticks.x = element_blank(),

      axis.text.x = element_blank(),

      axis.line.x = element_blank())

  a4 <- ggplot(

    data = data_plot[data_plot$disease==group_id[2],],

    mapping = aes(x = position, y = coverage, fill = celltype)

  ) +

    geom_area(stat = "identity") +

    geom_hline(yintercept = 0, size = 0.1) +

    xlab("")+

    ylab("")+

    ggtitle(group_id[2])+

    theme_browser(legend = FALSE) +

    facet_grid(celltype ~.)+

    theme(

      plot.title = element_text(size = 14,hjust = 0.5, face = 'bold'),

      strip.text.y = element_blank(),

      axis.ticks = element_blank(),

      axis.text = element_blank(),

      axis.line = element_blank())

  a5 <- a2 + ylab("")

  a6 <- a1 + ylab("")

  p3 <- a3 + a2 + a1  + plot_layout(heights = c(6,1,1))

  p4 <- a4 + a5 + a6  + plot_layout(heights = c(6,1,1))

  plot_grid(p3, p4, ncol = 2, rel_widths = c(2.4, 2))

}

#' Add extended windows for coverage plot

#'

#' This function is to add an extended window for ploting

#'

#' @param region Gene region for plotting

#' @param up_stream Upper range of the slide window

#' @param down_stream Lower range of the slide window

#' @return Gene range for plot

#' @export

add_sliding_windows <- function(

  region,

  up_stream, 

  down_stream

){

  reg_list<-strsplit(region, split = "-")

  reg_list<-as.character(unlist(reg_list))

  new_reg<-paste(reg_list[1], as.integer(reg_list[2])-down_stream, as.integer(reg_list[3])+up_stream, sep = "-")

  new_reg

}

 No newline at end of file

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Functions

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#' Modified DotPlot

#'

#' This function is a modified version of the DotPlot function in Seurat

#'

#' @param seu_obj A complete Seurat object

#' @param features A vector of gene names.

#' @return A ggplot object

#' @export

modified_dotplot <- function(

  seu_obj, 

  features, 

  col_palette = NULL,

  scale.by='radius'

){

  levels(seu_obj) <- rev(levels(seu_obj))

  dataplot<-DotPlot(seu_obj, features = features)

  dataplot<-dataplot$data

  dataplot$avg.exp<-scale(dataplot$avg.exp)

  colnames(dataplot)[1:2]<-c('Avg.Exp', 'Pct.Exp')

  if(is.null(col_palette)){

    col_palette = colorRampPalette(c('grey80','lemonchiffon1','indianred1','darkred'))(255)

  }

  scale.func <- switch(

    EXPR = scale.by,

    'size' = scale_size,

    'radius' = scale_radius,

    stop("'scale.by' must be either 'size' or 'radius'")

  )

  if(max(dataplot$Pct.Exp)>=20) {

    dotplot<-ggplot(dataplot, aes(x = features.plot, y = id, fill=Avg.Exp)) + 

      geom_tile(fill="white", color="white") +

      geom_point(aes( size =Pct.Exp), shape=21, color='grey80')  +  

      scale_fill_gradientn(colours  =  col_palette)+

      scale_size(range = c(0, 10))+

      theme(panel.background = element_rect(fill = "white", colour = "black"),

            axis.line = element_blank(),axis.text.x = element_text(angle = 45, hjust = 1), 

            legend.key = element_rect(colour = NA, fill = NA),

            axis.text = element_text(size = 12),axis.title=element_text(size=8),legend.text=element_text(size=8), 

            legend.title = element_text(size = 10),legend.position="right", legend.margin=margin())+ylab("")+xlab("")+

      guides(size = guide_legend(override.aes = list(color='black')))

  } else {

    dotplot<-ggplot(dataplot, aes(x = features.plot, y = id, fill=Avg.Exp)) +  

      geom_tile(fill="white", color="white") +

      geom_point(aes( size =Pct.Exp), shape=21, color='grey80')  +  

      scale_fill_gradientn(colours  = col_palette)+

      scale.func(range = c(0, 10), limits = c(0, 20)) +

      theme(panel.background = element_rect(fill = "white", colour = "black"),

            axis.line = element_blank(),axis.text.x = element_text(angle = 45, hjust = 1), 

            legend.key = element_rect(colour = NA, fill = NA),

            axis.text = element_text(size = 12),axis.title=element_text(size=8),legend.text=element_text(size=8), 

            legend.title = element_text(size = 10),legend.position="right", legend.margin=margin())+ylab("")+xlab("")+

      guides(size = guide_legend(override.aes = list(color='black')))

  }

  dotplot

}

#' Modified DimPlot

#'

#' This function is a modified version of the DimPlot function in Seurat

#'

#' @param seu_obj A complete Seurat object

#' @param colors Colors to label the clusters

#' @param pt.size Size of the data points

#' @param label.box Whether or not to label the cell type name

#' @param label.size Font size of the labels

#' @param title Main title of the plot

#' @return A ggplot object

#' @export

modified_dimplot <- function(

  seu_obj,

  colors = NULL,

  pt.size = 0.5,

  label.box = T,

  label.size = 6,

  title = "UMAP plot"

  ){

  if(is.null(colors)){

    colors = scales::hue_pal()(length(levels(seu_obj)))

  }

  x0<-min(seu_obj@reductions$umap@cell.embeddings[,1])

  x1<-x0+(max(seu_obj@reductions$umap@cell.embeddings[,1])-min(seu_obj@reductions$umap@cell.embeddings[,1]))/8

  y0<-min(seu_obj@reductions$umap@cell.embeddings[,2])

  y1<-y0+(max(seu_obj@reductions$umap@cell.embeddings[,2])-min(seu_obj@reductions$umap@cell.embeddings[,2]))/8

  DimPlot(seu_obj, label = T, cols = colors,label.box = label.box, 

        label.size = label.size, pt.size = pt.size, raster = F)+NoLegend()+NoAxes()+

  geom_segment(aes(x=x0, xend = x1 , y=y0, yend = y0), size=0.8,

               arrow = arrow(length = unit(0.2,"cm"))) +

  geom_segment(aes(x=x0, xend = x0 , y=y0, yend = y1), size=0.8,

               arrow = arrow(length = unit(0.2,"cm"))) +

  xlab("UMAP_1")+theme(axis.title.x = element_text(hjust = 0.05, size = 12))+

  ylab('UMAP_2')+theme(axis.title.y = element_text(hjust = 0.05, angle = 90, size = 12))+

  ggtitle(title)+theme(plot.title = element_text(hjust = 0.5))

}

 No newline at end of file

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# Functions

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#' Convert coordinates

#'

#' This function converts the Cartesian coordinates to Polar coordinates. 

#' Input data can be the coordinates from tSNE or UMAP. It outputs a matrix with

#' polar coordinates.

#'

#' @param coord_data Cartesian coordinates from tSNE, UMAP, etc.

#' @param zoom value from c(0,1) to adjust the coordinates.

#' @return A matrix with polar coordinates

#' @export

transform_coordinates <- function(

  coord_data, 

  zoom

  ){

  center_data<-coord_data-mean(c(min(coord_data),max(coord_data)))

  max_data<-max(center_data)

  new_data<-center_data*zoom/max_data

  new_data

}

#' Get metadata from a Seurat object

#'

#' This function extracts the metadata from a Seurat object and transforms the

#' UMAP/tSNE coordinates.

#'

#' @param obj SeuratObject

#' @param reductions reductions methods, e.g."umap" or "tsne".

#' @param color Colors assigned to the cell clusters

#' @param coord_scale value from c(0,1) to adjust the UMAP/tSNE coordinates.

#' @return A metadata dataframe

#' @export

get_metadata <- function(

  obj, 

  reductions = "umap", 

  coord_scale = 0.8, 

  color

  ){

  metadata<-obj@meta.data

  metadata$Cluster<-obj@active.ident

  metadata$dim1<-as.numeric(obj[[reductions]]@cell.embeddings[,1])

  metadata$dim2<-as.numeric(obj[[reductions]]@cell.embeddings[,2])

  metadata$x<-transform_coordinates(metadata$dim1, zoom = coord_scale)

  metadata$y<-transform_coordinates(metadata$dim2, zoom = coord_scale)

  color_df<-data.frame(Cluster=levels(obj), Colors=color)

  cellnames<-rownames(metadata)

  metadata$cells<-rownames(metadata)

  metadata<-merge(metadata, color_df, by='Cluster')

  rownames(metadata)<-metadata$cells

  metadata<-metadata[cellnames,]

  metadata

}

#' Make count matrix for the selected markers

#'

#' This function labels the cells based their expression levels of the selected 

#' marker genes.

#'

#' @param obj SeuratObject

#' @param features Selected marker genes

#' @return A dataframe with cells labeled by marker genes

#' @export

mk_marker_ct <- function(

  obj, 

  features

  ){

  dat <- Seurat::FetchData(obj, vars = features)

  ori_names <- rownames(dat)

  zero_ct <- dat[rowSums(dat)==0,]

  non_zero <- dat[rowSums(dat)!=0,]

  max_genes <- colnames(non_zero)[max.col(non_zero,ties.method="first")]

  non_zero <- data.frame(cells=rownames(non_zero), genes=max_genes)

  zero_ct <- data.frame(cells=rownames(zero_ct), genes='No_expr')

  all_cells <- rbind(non_zero, zero_ct)

  rownames(all_cells) <- all_cells$cells

  all_cells <- all_cells[ori_names,]

  all_cells

}

#' Create a dataframe for color mapping

#'

#' This function assigns a color for each value in a vector

#'

#' @param group Group to be assigned color

#' @return A dataframe with colors assigned to groups

#' @export

mk_color_table <- function(group){

  n=length(group)

  colors=scales::hue_pal()(n)

  color_table <- data.frame(group, colors)

  color_table

}

#' Order the cells from each cluster

#'

#' This function orders the cells from each cluster by giving a value from

#' 1 to max

#' @param dat Data input. 

#' @return An vector with ordered cells

#' @export

cell_order <- function(dat){

  celltypes <- names(table(dat$Cluster))

  new_dat <- list()

  for (i in 1:length(celltypes)){

    dat$Cluster<-as.character(dat$Cluster)

    dat1<-dat[dat$Cluster==celltypes[i],]

    dat1$x_polar<-1:nrow(dat1)

    new_dat[[i]]<-dat1

  }

  new_dat<-do.call('rbind', new_dat)

  new_dat

}

#' Create a segment for each element in a group

#'

#' This function creates a segment for each element within a group

#' @param dat Data input. 

#' @param group The group name

#' @return An vector with ordered cells

#' @export

get_segment <- function(

  dat, 

  group

  ){

  dat<-dat[order(dat[,group],decreasing = F), ]

  rownames(dat)<-1:nrow(dat)

  dat<-dat[!duplicated(dat[,group]),]

  dat_seg<-as.integer(rownames(dat))

  dat_seg

}

#' Prepare circlize data for plotting

#'

#' This function creates a segment for each element within a group

#' @param seu_obj Seurat object 

#' @param scale Scale factor to zoom in our zoom out the tSNE/UMAP proportionally

#' @return A data frame for plotting

#' @export

prepare_circlize_data <- function(

  seu_obj, 

  scale =0.8

  ){

  celltypes<-levels(seu_obj)

  cell_colors <- scales::hue_pal()(length(celltypes))

  data_plot <- get_metadata(seu_obj, color = cell_colors, coord_scale = scale)

  data_plot <- cell_order(data_plot)

  data_plot$x_polar2 <- log10(data_plot$x_polar)

  data_plot

}

#' Generate a circlize plot outside the tSNE/UMAP

#'

#' This function generates a circlize plot outside the tSNE/UMAP

#'

#' @param data_plot Data frame prepared by the prepare_circlize_data function

#' @param do.label Whether to label the clusters

#' @param contour.levels Which contour line to be drawn on the plot. Value: 0-1

#' @param bg.color Canvas background color

#' @param pt.size Point size of the graph

#' @param kde2d.n Number of grid points in each direction. A kde2d parameter

#' @param contour.nlevels Total number of levels in contour

#' @return Return a circlize plot

#' @export

plot_circlize <- function(

  data_plot,

  do.label = T,

  contour.levels = c(0.2,0.3),

  pt.size = 0.5,

  kde2d.n = 1000,

  contour.nlevels = 100,

  bg.color='#F9F2E4'

  ) {

  data_plot %>%

    dplyr::group_by(Cluster) %>%

    summarize(x = median(x = x),y = median(x = y)) -> centers

  z <- MASS::kde2d(data_plot$x, data_plot$y, n=kde2d.n)

  celltypes<-names(table(data_plot$Cluster))

  cell_colors <- scales::hue_pal()(length(celltypes))

  circos.clear()

  par(bg = bg.color)

  circos.par(cell.padding=c(0,0,0,0), track.margin=c(0.01,0),"track.height" = 0.01, gap.degree =c(rep(2, (length(celltypes)-1)),12))

  circos.initialize(sectors =  data_plot$Cluster, x = data_plot$x_polar2)

  circos.track(data_plot$Cluster, data_plot$x_polar2, y=data_plot$dim2, bg.border=NA,panel.fun = function(x, y) {

    circos.text(CELL_META$xcenter,

                CELL_META$cell.ylim[2]+ mm_y(4),

                CELL_META$sector.index,

                cex=0.5, col = 'black', facing = "bending.inside", niceFacing = T)

    circos.axis(labels.cex = 0.3, col = 'black', labels.col =  'black')

  })

  for(i in 1:length(celltypes)){

    dd<-data_plot[data_plot$Cluster==celltypes[i],]

    circos.segments(x0 = min(dd$x_polar2), y0 = 0, x1 = max(dd$x_polar2), y1 = 0, col = cell_colors[i],  lwd=3, sector.index = celltypes[i])

  }

  text(x = 1, y=0.1, labels = "Cluster", cex = 0.4, col = 'black',srt=-90)

  points(data_plot$x,data_plot$y, pch = 19, col = alpha(data_plot$Colors,0.2), cex = pt.size);

  contour(z, drawlabels=F, nlevels= 100, levels = contour.levels,col = '#ae9c76', add=TRUE)

  if(do.label){

  text(centers$x,centers$y, labels=centers$Cluster, cex = 0.8, col = 'black')

  }

}

#' Add tracts to the circlize plot

#'

#' This function allows users to add more tracks into the circlize plot

#' @param data_plot Data for circlize plot 

#' @param group The group for showing on the new track

#' @param colors Color palette to color the group

#' @return A new circlize track adding to the current circlize plot

#' @export

add_tract <- function(data_plot, group, colors = NULL){

  circos.track(data_plot$Cluster, data_plot$x_polar2, y=data_plot$dim2, bg.border=NA)

  celltypes<-names(table(data_plot$Cluster))

  group_names<-names(table(data_plot[,group]))

  if(is.null(colors)){

    col_group = scales::hue_pal()(length(group_names))

  } else {

    col_group = colors

  }

  for(i in 1:length(celltypes)) {

    data_plot_cl<-data_plot[data_plot$Cluster==celltypes[i],]

    dat_seg<-get_segment(data_plot_cl, group = group)

    dat_seg2<-c(dat_seg[-1]-1, nrow(data_plot_cl))

    scale_factor<-max(data_plot_cl$x_polar2)/nrow(data_plot_cl)

    dat_seg<-scale_factor*dat_seg

    dat_seg2<-scale_factor*dat_seg2

    circos.segments(x0 = dat_seg, y0 = 0, x1 = dat_seg2, y1 = 0, col = col_group, sector.index = celltypes[i], lwd=3)

  }

}