## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----eval=FALSE--------------------------------------------------------------- # if (!requireNamespace("BiocManager", quietly = TRUE)) { # install.packages("BiocManager") # } # BiocManager::install("CARDspa") ## ----------------------------------------------------------------------------- library(CARDspa) library(RcppML) library(NMF) library(RcppArmadillo) library(SingleCellExperiment) library(SpatialExperiment) library(ggplot2) #### load the example spatial transcriptomics count data, data(spatial_count) spatial_count[1:4, 1:4] ## ----------------------------------------------------------------------------- #### load the example spatial location data, data(spatial_location) spatial_location[1:4, ] ## ----------------------------------------------------------------------------- data(sc_count) sc_count[1:4, 1:4] ## ----------------------------------------------------------------------------- data(sc_meta) sc_meta[1:4, ] ## ----------------------------------------------------------------------------- set.seed(seed = 20200107) CARD_obj <- CARD_deconvolution( sc_count = sc_count, sc_meta = sc_meta, spatial_count = spatial_count, spatial_location = spatial_location, ct_varname = "cellType", ct_select = unique(sc_meta$cellType), sample_varname = "sampleInfo", mincountgene = 100, mincountspot = 5 ) ## QC on scRNASeq dataset! ... ## QC on spatially-resolved dataset! .. ## create reference matrix from scRNASeq... ## Select Informative Genes! ... ## Deconvolution Starts! ... ## Deconvolution Finish! ... ## ----------------------------------------------------------------------------- ## create sce object sce <- SingleCellExperiment(assay = list(counts = sc_count), colData = sc_meta) ## create spe object spe <- SpatialExperiment(assay = list(counts = spatial_count), spatialCoords = as.matrix(spatial_location) ) celltypes <- unique(sc_meta$cellType) set.seed(seed = 20200107) CARD_obj <- CARD_deconvolution( spe = spe, sce = sce, sc_count = NULL, sc_meta = NULL, spatial_count = NULL, spatial_location = NULL, ct_varname = "cellType", ct_select = celltypes, sample_varname = "sampleInfo", mincountgene = 100, mincountspot = 5 ) ## ----------------------------------------------------------------------------- print(CARD_obj$Proportion_CARD[1:2, ]) ## ----------------------------------------------------------------------------- ## set the colors. Here, I just use the colors in the manuscript, if the color ## is not provided, the function will use default color in the package. colors <- c( "#FFD92F", "#4DAF4A", "#FCCDE5", "#D9D9D9", "#377EB8", "#7FC97F", "#BEAED4", "#FDC086", "#FFFF99", "#386CB0", "#F0027F", "#BF5B17", "#666666", "#1B9E77", "#D95F02", "#7570B3", "#E7298A", "#66A61E", "#E6AB02", "#A6761D" ) p1 <- CARD_visualize_pie( proportion = CARD_obj$Proportion_CARD, spatial_location = spatialCoords(CARD_obj), colors = colors, radius = 0.52 ) ### You can choose radius = NULL or your own radius number print(p1) ## ----------------------------------------------------------------------------- ## select the cell type that we are interested ct.visualize <- c( "Acinar_cells", "Cancer_clone_A", "Cancer_clone_B", "Ductal_terminal_ductal_like", "Ductal_CRISP3_high-centroacinar_like", "Ductal_MHC_Class_II", "Ductal_APOL1_high-hypoxic", "Fibroblasts" ) ## visualize the spatial distribution of the cell type proportion p2 <- CARD_visualize_prop( proportion = CARD_obj$Proportion_CARD, spatial_location = spatialCoords(CARD_obj), ### selected cell types to visualize ct_visualize = ct.visualize, ### if not provide, we will use the default colors colors = c("lightblue", "lightyellow", "red"), ### number of columns in the figure panel NumCols = 4, ### point size in ggplot2 scatterplot pointSize = 3.0 ) print(p2) ## ----------------------------------------------------------------------------- ## visualize the spatial distribution of two cell types on the same plot p3 <- CARD_visualize_prop_2CT( ### Cell type proportion estimated by CARD proportion = CARD_obj$Proportion_CARD, ### spatial location information spatial_location = spatialCoords(CARD_obj), ### two cell types you want to visualize ct2_visualize = c("Cancer_clone_A", "Cancer_clone_B"), ### two color scales colors = list( c("lightblue", "lightyellow", "red"), c("lightblue", "lightyellow", "black") ) ) print(p3) ## ----------------------------------------------------------------------------- # if not provide, we will use the default colors p4 <- CARD_visualize_Cor(CARD_obj$Proportion_CARD, colors = NULL) print(p4) ## ----------------------------------------------------------------------------- CARD_obj <- CARD_imputation( CARD_obj, num_grids = 2000, ineibor = 10, exclude = NULL) ## The rownames of locations are matched ... ## Make grids on new spatial locations ... ## ----------------------------------------------------------------------------- ## Visualize the newly grided spatial locations to see if the shape is correctly ## detected. If not, the user can provide the row names of the excluded spatial ## location data into the CARD_imputation function location_imputation <- cbind.data.frame( x = as.numeric(sapply( strsplit(rownames(CARD_obj$refined_prop), split = "x"), "[", 1 )), y = as.numeric(sapply( strsplit(rownames(CARD_obj$refined_prop), split = "x"), "[", 2 )) ) rownames(location_imputation) <- rownames(CARD_obj$refined_prop) library(ggplot2) p5 <- ggplot( location_imputation, aes(x = x, y = y) ) + geom_point(shape = 22, color = "#7dc7f5") + theme( plot.margin = margin(0.1, 0.1, 0.1, 0.1, "cm"), legend.position = "bottom", panel.background = element_blank(), plot.background = element_blank(), panel.border = element_rect(colour = "grey89", fill = NA, linewidth = 0.5) ) print(p5) ## ----------------------------------------------------------------------------- p6 <- CARD_visualize_prop( proportion = CARD_obj$refined_prop, spatial_location = location_imputation, ct_visualize = ct.visualize, colors = c("lightblue", "lightyellow", "red"), NumCols = 4 ) print(p6) ## ----------------------------------------------------------------------------- p7 <- CARD_visualize_gene( spatial_expression = assays(CARD_obj)$refined_expression, spatial_location = location_imputation, gene_visualize = c("A4GNT", "AAMDC", "CD248"), colors = NULL, NumCols = 6 ) print(p7) ## ----------------------------------------------------------------------------- p8 <- CARD_visualize_gene( spatial_expression = metadata(CARD_obj)$spatial_countMat, spatial_location = metadata(CARD_obj)$spatial_location, gene_visualize = c("A4GNT", "AAMDC", "CD248"), colors = NULL, NumCols = 6 ) print(p8) ## ----------------------------------------------------------------------------- ## deconvolution using CARDfree data(markerList) set.seed(seed = 20200107) CARDfree_obj <- CARD_refFree( markerlist = markerList, spatial_count = spatial_count, spatial_location = spatial_location, mincountgene = 100, mincountspot = 5 ) ## ----------------------------------------------------------------------------- data(markerList) set.seed(seed = 20200107) CARDfree_obj <- CARD_refFree( markerlist = markerList, spatial_count = NULL, spatial_location = NULL, spe = spe, mincountgene = 100, mincountspot = 5 ) ## ----------------------------------------------------------------------------- ## One limitation of reference-free version of CARD is that the cell ## types inferred ## from CARDfree do not come with a cell type label. It might be difficult to ## interpret the results. print(CARDfree_obj$Proportion_CARD[1:2, ]) ## ----------------------------------------------------------------------------- colors <- c( "#FFD92F", "#4DAF4A", "#FCCDE5", "#D9D9D9", "#377EB8", "#7FC97F", "#BEAED4", "#FDC086", "#FFFF99", "#386CB0", "#F0027F", "#BF5B17", "#666666", "#1B9E77", "#D95F02", "#7570B3", "#E7298A", "#66A61E", "#E6AB02", "#A6761D" ) ### In order to maximumply match with the original results of CARD, we order the ### colors to generally match with the results infered by CARD current_data <- CARDfree_obj$Proportion_CARD new_order <- current_data[, c( 8, 10, 14, 2, 1, 6, 12, 18, 7, 13, 20, 19, 16, 17, 11, 15, 4, 9, 3, 5 )] CARDfree_obj$Proportion_CARD <- new_order colnames(CARDfree_obj$Proportion_CARD) <- paste0("CT", 1:20) p9 <- CARD_visualize_pie(CARDfree_obj$Proportion_CARD, spatialCoords(CARDfree_obj), colors = colors ) print(p9) ## ----------------------------------------------------------------------------- #### Note that here the shapeSpot is the user defined variable which #### indicates the capturing area of single cells. Details see above. set.seed(seed = 20210107) scMapping <- CARD_scmapping(CARD_obj, shapeSpot = "Square", numcell = 20, ncore = 2) print(scMapping) ### spatial location info and expression count of the single cell resolution ### data MapCellCords <- as.data.frame(colData(scMapping)) count_SC <- assays(scMapping)$counts ## ----------------------------------------------------------------------------- df <- MapCellCords colors <- c( "#8DD3C7", "#CFECBB", "#F4F4B9", "#CFCCCF", "#D1A7B9", "#E9D3DE", "#F4867C", "#C0979F", "#D5CFD6", "#86B1CD", "#CEB28B", "#EDBC63", "#C59CC5", "#C09CBF", "#C2D567", "#C9DAC3", "#E1EBA0", "#FFED6F", "#CDD796", "#F8CDDE" ) p10 <- ggplot(df, aes(x = x, y = y, colour = CT)) + geom_point(size = 3.0) + scale_colour_manual(values = colors) + # facet_wrap(~Method,ncol = 2,nrow = 3) + theme( plot.margin = margin(0.1, 0.1, 0.1, 0.1, "cm"), panel.background = element_rect(colour = "white", fill = "white"), plot.background = element_rect(colour = "white", fill = "white"), legend.position = "bottom", panel.border = element_rect( colour = "grey89", fill = NA, linewidth = 0.5), axis.text = element_blank(), axis.ticks = element_blank(), axis.title = element_blank(), legend.title = element_text(size = 13, face = "bold"), legend.text = element_text(size = 12), legend.key = element_rect(colour = "transparent", fill = "white"), legend.key.size = unit(0.45, "cm"), strip.text = element_text(size = 15, face = "bold") ) + guides(color = guide_legend(title = "Cell Type")) print(p10) ## ----------------------------------------------------------------------------- sessionInfo()