Heatmaps with multiple metadata annotations

[AMA111]

Dear Developer,

I would like to ask if there is a a way of plotting multiple annotations (Cluster info, cell type, other ) from the metadata to the top of the heat map after doing DE analysis .. Like this one:

Thank you in advance!

Best, Abdelrahman

[edroaldo]

Sorry for my delayed response. I have been hopeful to release some updates in cellrouter but still could not find the time. At the meantime, you can use the function below, which should do what you want but I have not extensively tested it. So, please, let me know how it goes.

This is how you can use it. You specify your metadata columns using the parameter *column.ann2. *The colores on the top of the heatmap will not match the ones from your tSNE analysis colored by the same metadata though. I will fix this later but first, please let me know if the function works in your hands.

Thanks!

plotSignaturesHeatmap2(cellrouter, top, column.ann = 'population', column.ann2=c('metadata1', 'metadata2', 'metadata3'), column.color = 'population_color', #num.cells = 150, threshold = 1.5, width = 20, height = 15, filename = filename)

plotSignaturesHeatmap2 <- function(object, markers, column.ann, column.ann2, column.color, num.cells=NULL, threshold=2, genes.show=NULL, low='purple', intermediate='black', high='yellow', order=NULL, width, height, filename){

if(is.null(num.cells)){ print('here') cells.keep <- rownames(object@sampTab) print(table(object@sampTab[[column.ann]])) }else{ #cells.use <- object@sampTab %>% group_by_(column.ann) %>% sample_n(size = num.cells, replace = TRUE) cells.use <- split(object@sampTab, object@sampTab[[column.ann]]) cells.use <- lapply(cells.use, function(x){ if(nrow(x) < num.cells){ cells.use.x <- x[sample(rownames(x), size = nrow(x)),] }else{ cells.use.xx <- x[sample(rownames(x), size = num.cells),] } }) cells.use.tmp <- do.call(rbind, cells.use) cells.keep <- as.vector(cells.use.tmp$sample_id) }

#data <- object@ndata[,cells.use] matrix <- center_with_threshold(object@ndata[,cells.keep], threshold)

paletteLength <- 100 #myColor <- colorRampPalette(c("purple","black","yellow"))(paletteLength) myColor <- colorRampPalette(c(low, intermediate, high))(paletteLength) myBreaks <- c(seq(min(matrix), 0, length.out=ceiling(paletteLength/2) + 1), seq(max(matrix)/paletteLength, max(matrix), length.out=floor(paletteLength/2)))

library(data.table) markers2 <- as.data.frame(markers) #markers2 <- as.data.frame(markers) #markers2 <- as.data.table(markers2)[, .SD[which.max(fc.column)], by=gene] #markers2 <- as.data.frame(markers2) #markers2 <- as.data.frame(markers) #markers2 <- markers2[!duplicated(markers2$gene),] #need to make sure there is no duplicated element... sampTab <- object@sampTab sampTab <- sampTab[cells.keep,]

if(column.ann == 'population'){ markers2 <- markers2[order(as.numeric(markers2$population)),] rownames(markers2) <- as.vector(markers2$gene) sampTab <- sampTab[order(as.numeric(sampTab$population)),] }else if(!is.null(order)){ markers2 <- markers2[order(factor(markers2$population, levels=order)),] sampTab <- sampTab[order(factor(sampTab[[column.ann]], levels=order)),] }else{ markers2 <- markers2[order(as.character(markers2$population)),] rownames(markers2) <- as.vector(markers2$gene) sampTab <- sampTab[order(as.character(sampTab[[column.ann]])),] }

#clusters <- as.vector(object@sampTab$population) #clusters <- as.vector(sampTab[[column.ann]]) #names(clusters) <- rownames(sampTab) #clusters <- clusters[order(clusters)] ann_col <- sampTab[, c(column.ann, column.ann2)]#data.frame(population=as.vector(clusters), stringsAsFactors = FALSE) #rownames(ann_col) <- names(clusters)

ann_row <- data.frame(signature=as.vector(markers2$population), stringsAsFactors = FALSE) rownames(ann_row) <- as.vector(markers2$gene) if(!is.null(order)){ ann_col$population <- factor(ann_col$population, levels=order) ann_row$signature <- factor(ann_row$signature, levels=order) }

#colors <- cRampClust(cluster.vector, 8) #names(colors) <- cluster.vector colors <- unique(sampTab[[column.color]]) names(colors) <- unique(as.vector(sampTab[[column.ann]]))

color_lists <- list(population=colors, signature=colors)

#replicate_row <- as.vector(unlist(lapply(split(ann_row, ann_row$signature), nrow))) #colors_row <- rep(colors, times=replicate_row) #replicate_col <- as.vector(unlist(lapply(split(ann_col, ann_col$population), nrow))) #colors_col <- rep(colors, times=replicate_col) index <- getIndexes(ann_col, ann_row, order.columns = unique(ann_col$population), order.rows = unique(ann_row$signature))

if(is.null(genes.show)){ genes.show <- markers2 %>% group_by(population) %>% top_n(5, fc) genes.show <- as.vector(genes.show$gene) selected <- as.vector(markers2$gene) selected[!(selected %in% genes.show)] <- "" }else{ selected <- as.vector(markers2$gene) selected[!(selected %in% genes.show)] <- "" }

pheatmap(matrix[rownames(ann_row),rownames(ann_col)], cluster_rows=FALSE, cluster_cols=FALSE, color = myColor, breaks=myBreaks, fontsize=15, #gaps_row = index$rowsep, gaps_col = index$colsep, annotation_col = ann_col, annotation_row = ann_row, annotation_colors = color_lists, labels_row = selected, labels_col = rep("", ncol(matrix)), width=width, height=height, filename=filename)

gc(verbose = FALSE)

}

On Thu, May 9, 2019 at 5:04 AM AMA111 [email protected] wrote:

Dear Developer,

I would like to ask if there is a a way of plotting multiple annotations (Cluster info, cell type, other ) from the metadata to the top of the heat map after doing DE analysis .. Like this one: [image: image] https://user-images.githubusercontent.com/29317258/57441307-f29c0100-7249-11e9-8980-7075d01d5745.png

Thank you in advance!

Best, Abdelrahman

— You are receiving this because you are subscribed to this thread. Reply to this email directly, view it on GitHub https://github.com/edroaldo/cellrouter/issues/26, or mute the thread https://github.com/notifications/unsubscribe-auth/ACNJIR3CCKNQHAAWHKMHAH3PUPSIRANCNFSM4HLYRY3A .

-- Edroaldo

[AMA111]

Hey, It didn't work. I think still needs many optimization and robust testing.

plotSignaturesHeatmap2 <- function(object, markers, column.ann, + column.ann2, column.color, num.cells=NULL, threshold=2, genes.show=NULL, + low='purple', intermediate='black', + high='yellow', order=NULL, width, height, filename){ + + if(is.null(num.cells)){ + print('here') + cells.keep <- rownames(object@sampTab) + print(table(object@sampTab[[column.ann]])) + }else{ + #cells.use <- object@sampTab %>% group_by_(column.ann) %>% + sample_n(size = num.cells, replace = TRUE) + cells.use <- split(object@sampTab, object@sampTab[[column.ann]]) + cells.use <- lapply(cells.use, function(x){ + if(nrow(x) < num.cells){ + cells.use.x <- x[sample(rownames(x), size = nrow(x)),] + }else{ + cells.use.xx <- x[sample(rownames(x), size = num.cells),] + } + }) + cells.use.tmp <- do.call(rbind, cells.use) + cells.keep <- as.vector(cells.use.tmp$sample_id) + } + + #data <- object@ndata[,cells.use] + matrix <- center_with_threshold(object@ndata[,cells.keep], threshold) + + paletteLength <- 100 + #myColor <- colorRampPalette(c("purple","black","yellow"))(paletteLength) + myColor <- colorRampPalette(c(low, intermediate, high))(paletteLength) + myBreaks <- c(seq(min(matrix), 0, length.out=ceiling(paletteLength/2) + + 1), + seq(max(matrix)/paletteLength, max(matrix), + length.out=floor(paletteLength/2))) + + + library(data.table) + markers2 <- as.data.frame(markers) + #markers2 <- as.data.frame(markers) + #markers2 <- as.data.table(markers2)[, .SD[which.max(fc.column)], by=gene] + #markers2 <- as.data.frame(markers2) + #markers2 <- as.data.frame(markers) + #markers2 <- markers2[!duplicated(markers2$gene),] #need to make sure + there is no duplicated element... Error: unexpected symbol in: " #markers2 <- markers2[!duplicated(markers2$gene),] #need to make sure there is" > sampTab <- object@sampTab Error: object 'object' not found > sampTab <- sampTab[cells.keep,] Error: object 'sampTab' not found > > if(column.ann == 'population'){ + markers2 <- markers2[order(as.numeric(markers2$population)),] + rownames(markers2) <- as.vector(markers2$gene) + sampTab <- sampTab[order(as.numeric(sampTab$population)),] + }else if(!is.null(order)){ + markers2 <- markers2[order(factor(markers2$population, levels=order)),] + sampTab <- sampTab[order(factor(sampTab[[column.ann]], levels=order)),] + }else{ + markers2 <- markers2[order(as.character(markers2$population)),] + rownames(markers2) <- as.vector(markers2$gene) + sampTab <- sampTab[order(as.character(sampTab[[column.ann]])),] + } Error: object 'column.ann' not found > > #clusters <- as.vector(object@sampTab$population) > #clusters <- as.vector(sampTab[[column.ann]]) > #names(clusters) <- rownames(sampTab) > #clusters <- clusters[order(clusters)] > ann_col <- sampTab[, c(column.ann, + column.ann2)]#data.frame(population=as.vector(clusters), stringsAsFactors = Error: object 'sampTab' not found > FALSE) Error: unexpected ')' in " FALSE)" > #rownames(ann_col) <- names(clusters) > > ann_row <- data.frame(signature=as.vector(markers2$population), + stringsAsFactors = FALSE) Error in as.vector(markers2$population) : object 'markers2' not found > rownames(ann_row) <- as.vector(markers2$gene) Error in as.vector(markers2$gene) : object 'markers2' not found > if(!is.null(order)){ + ann_col$population <- factor(ann_col$population, levels=order) + ann_row$signature <- factor(ann_row$signature, levels=order) + } Error in factor(ann_col$population, levels = order) : object 'ann_col' not found > > #colors <- cRampClust(cluster.vector, 8) > #names(colors) <- cluster.vector > colors <- unique(sampTab[[column.color]]) Error in unique(sampTab[[column.color]]) : object 'sampTab' not found > names(colors) <- unique(as.vector(sampTab[[column.ann]])) Error in as.vector(sampTab[[column.ann]]) : object 'sampTab' not found > > color_lists <- list(population=colors, signature=colors) > > #replicate_row <- as.vector(unlist(lapply(split(ann_row, > ann_row$signature), nrow))) Error: unexpected ')' in "ann_row$signature)" > #colors_row <- rep(colors, times=replicate_row) > #replicate_col <- as.vector(unlist(lapply(split(ann_col, > ann_col$population), nrow))) Error: unexpected ')' in "ann_col$population)" > #colors_col <- rep(colors, times=replicate_col) > index <- getIndexes(ann_col, ann_row, order.columns = + unique(ann_col$population), order.rows = unique(ann_row$signature)) Show Traceback Rerun with Debug Error in nrow(ann_col) : object 'ann_col' not found > > if(is.null(genes.show)){ + genes.show <- markers2 %>% group_by(population) %>% top_n(5, fc) + genes.show <- as.vector(genes.show$gene) + selected <- as.vector(markers2$gene) + selected[!(selected %in% genes.show)] <- "" + }else{ + selected <- as.vector(markers2$gene) + selected[!(selected %in% genes.show)] <- "" + } Error: object 'genes.show' not found > > pheatmap(matrix[rownames(ann_row),rownames(ann_col)], cluster_rows=FALSE, + cluster_cols=FALSE, color = myColor, breaks=myBreaks, fontsize=15, + #gaps_row = index$rowsep, + gaps_col = index$colsep, annotation_col = ann_col, + annotation_row = ann_row, annotation_colors = color_lists, + labels_row = selected, + labels_col = rep("", ncol(matrix)), width=width, height=height, + filename=filename) Error in pheatmap(matrix[rownames(ann_row), rownames(ann_col)], cluster_rows = FALSE, : object 'selected' not found > > > gc(verbose = FALSE) used (Mb) gc trigger (Mb) max used (Mb) Ncells 4058624 216.8 6353278 339.4 6353278 339.4 Vcells 1415607002 10800.3 3111833001 23741.5 2168651371 16545.5 > > } Error: unexpected '}' in " }" > plotSignaturesHeatmap2 <- function(object, markers, column.ann, + column.ann2, column.color, num.cells=NULL, threshold=2, genes.show=NULL, + low='purple', intermediate='black', + high='yellow', order=NULL, width, height, filename){ + + if(is.null(num.cells)){ + print('here') + cells.keep <- rownames(object@sampTab) + print(table(object@sampTab[[column.ann]])) + }else{ + #cells.use <- object@sampTab %>% group_by_(column.ann) %>% + sample_n(size = num.cells, replace = TRUE) + cells.use <- split(object@sampTab, object@sampTab[[column.ann]]) + cells.use <- lapply(cells.use, function(x){ + if(nrow(x) < num.cells){ + cells.use.x <- x[sample(rownames(x), size = nrow(x)),] + }else{ + cells.use.xx <- x[sample(rownames(x), size = num.cells),] + } + }) + cells.use.tmp <- do.call(rbind, cells.use) + cells.keep <- as.vector(cells.use.tmp$sample_id) + } + + #data <- object@ndata[,cells.use] + matrix <- center_with_threshold(object@ndata[,cells.keep], threshold) + + paletteLength <- 100 + #myColor <- colorRampPalette(c("purple","black","yellow"))(paletteLength) + myColor <- colorRampPalette(c(low, intermediate, high))(paletteLength) + myBreaks <- c(seq(min(matrix), 0, length.out=ceiling(paletteLength/2) + + 1), + seq(max(matrix)/paletteLength, max(matrix), + length.out=floor(paletteLength/2))) + + + library(data.table) + markers2 <- as.data.frame(markers) + #markers2 <- as.data.frame(markers) + #markers2 <- as.data.table(markers2)[, .SD[which.max(fc.column)], by=gene] + #markers2 <- as.data.frame(markers2) + #markers2 <- as.data.frame(markers) + #markers2 <- markers2[!duplicated(markers2$gene),] #need to make sure + there is no duplicated element... Error: unexpected symbol in: " #markers2 <- markers2[!duplicated(markers2$gene),] #need to make sure there is" > sampTab <- object@sampTab Error: object 'object' not found > sampTab <- sampTab[cells.keep,] Error: object 'sampTab' not found > > if(column.ann == 'population'){ + markers2 <- markers2[order(as.numeric(markers2$population)),] + rownames(markers2) <- as.vector(markers2$gene) + sampTab <- sampTab[order(as.numeric(sampTab$population)),] + }else if(!is.null(order)){ + markers2 <- markers2[order(factor(markers2$population, levels=order)),] + sampTab <- sampTab[order(factor(sampTab[[column.ann]], levels=order)),] + }else{ + markers2 <- markers2[order(as.character(markers2$population)),] + rownames(markers2) <- as.vector(markers2$gene) + sampTab <- sampTab[order(as.character(sampTab[[column.ann]])),] + } Error: object 'column.ann' not found > > #clusters <- as.vector(object@sampTab$population) > #clusters <- as.vector(sampTab[[column.ann]]) > #names(clusters) <- rownames(sampTab) > #clusters <- clusters[order(clusters)] > ann_col <- sampTab[, c(column.ann, + column.ann2)]#data.frame(population=as.vector(clusters), stringsAsFactors = Error: object 'sampTab' not found > FALSE) Error: unexpected ')' in " FALSE)" > #rownames(ann_col) <- names(clusters) > > ann_row <- data.frame(signature=as.vector(markers2$population), + stringsAsFactors = FALSE) Error in as.vector(markers2$population) : object 'markers2' not found > rownames(ann_row) <- as.vector(markers2$gene) Error in as.vector(markers2$gene) : object 'markers2' not found > if(!is.null(order)){ + ann_col$population <- factor(ann_col$population, levels=order) + ann_row$signature <- factor(ann_row$signature, levels=order) + } Error in factor(ann_col$population, levels = order) : object 'ann_col' not found > > #colors <- cRampClust(cluster.vector, 8) > #names(colors) <- cluster.vector > colors <- unique(sampTab[[column.color]]) Error in unique(sampTab[[column.color]]) : object 'sampTab' not found > names(colors) <- unique(as.vector(sampTab[[column.ann]])) Error in as.vector(sampTab[[column.ann]]) : object 'sampTab' not found > > color_lists <- list(population=colors, signature=colors) > > #replicate_row <- as.vector(unlist(lapply(split(ann_row, > ann_row$signature), nrow))) Error: unexpected ')' in "ann_row$signature)" > #colors_row <- rep(colors, times=replicate_row) > #replicate_col <- as.vector(unlist(lapply(split(ann_col, > ann_col$population), nrow))) Error: unexpected ')' in "ann_col$population)" > #colors_col <- rep(colors, times=replicate_col) > index <- getIndexes(ann_col, ann_row, order.columns = + unique(ann_col$population), order.rows = unique(ann_row$signature)) Show Traceback Rerun with Debug Error in nrow(ann_col) : object 'ann_col' not found > > if(is.null(genes.show)){ + genes.show <- markers2 %>% group_by(population) %>% top_n(5, fc) + genes.show <- as.vector(genes.show$gene) + selected <- as.vector(markers2$gene) + selected[!(selected %in% genes.show)] <- "" + }else{ + selected <- as.vector(markers2$gene) + selected[!(selected %in% genes.show)] <- "" + } Error: object 'genes.show' not found > > pheatmap(matrix[rownames(ann_row),rownames(ann_col)], cluster_rows=FALSE, + cluster_cols=FALSE, color = myColor, breaks=myBreaks, fontsize=15, + #gaps_row = index$rowsep, + gaps_col = index$colsep, annotation_col = ann_col, + annotation_row = ann_row, annotation_colors = color_lists, + labels_row = selected, + labels_col = rep("", ncol(matrix)), width=width, height=height, + filename=filename) Error in pheatmap(matrix[rownames(ann_row), rownames(ann_col)], cluster_rows = FALSE, : object 'selected' not found > > > gc(verbose = FALSE) used (Mb) gc trigger (Mb) max used (Mb) Ncells 4058627 216.8 6353278 339.4 6353278 339.4 Vcells 1415607006 10800.3 3111833001 23741.5 2168651371 16545.5 > > } Error: unexpected '}' in "}" > plotSignaturesHeatmap2 <- function(object, markers, column.ann, + column.ann2, column.color, num.cells=NULL, threshold=2, genes.show=NULL, + low='purple', intermediate='black', + high='yellow', order=NULL, width, height, filename) + { + + if(is.null(num.cells)){ + print('here') + cells.keep <- rownames(object@sampTab) + print(table(object@sampTab[[column.ann]])) + }else{ + #cells.use <- object@sampTab %>% group_by_(column.ann) %>% + sample_n(size = num.cells, replace = TRUE) + cells.use <- split(object@sampTab, object@sampTab[[column.ann]]) + cells.use <- lapply(cells.use, function(x){ + if(nrow(x) < num.cells){ + cells.use.x <- x[sample(rownames(x), size = nrow(x)),] + }else{ + cells.use.xx <- x[sample(rownames(x), size = num.cells),] + } + }) + cells.use.tmp <- do.call(rbind, cells.use) + cells.keep <- as.vector(cells.use.tmp$sample_id) + } + + #data <- object@ndata[,cells.use] + matrix <- center_with_threshold(object@ndata[,cells.keep], threshold) + + paletteLength <- 100 + #myColor <- colorRampPalette(c("purple","black","yellow"))(paletteLength) + myColor <- colorRampPalette(c(low, intermediate, high))(paletteLength) + myBreaks <- c(seq(min(matrix), 0, length.out=ceiling(paletteLength/2) + + 1), + seq(max(matrix)/paletteLength, max(matrix), + length.out=floor(paletteLength/2))) + + + library(data.table) + markers2 <- as.data.frame(markers) + #markers2 <- as.data.frame(markers) + #markers2 <- as.data.table(markers2)[, .SD[which.max(fc.column)], by=gene] + #markers2 <- as.data.frame(markers2) + #markers2 <- as.data.frame(markers) + #markers2 <- markers2[!duplicated(markers2$gene),] #need to make sure + there is no duplicated element... Error: unexpected symbol in: " #markers2 <- markers2[!duplicated(markers2$gene),] #need to make sure there is" > sampTab <- object@sampTab Error: object 'object' not found > sampTab <- sampTab[cells.keep,] Error: object 'sampTab' not found > > if(column.ann == 'population'){ + markers2 <- markers2[order(as.numeric(markers2$population)),] + rownames(markers2) <- as.vector(markers2$gene) + sampTab <- sampTab[order(as.numeric(sampTab$population)),] + }else if(!is.null(order)){ + markers2 <- markers2[order(factor(markers2$population, levels=order)),] + sampTab <- sampTab[order(factor(sampTab[[column.ann]], levels=order)),] + }else{ + markers2 <- markers2[order(as.character(markers2$population)),] + rownames(markers2) <- as.vector(markers2$gene) + sampTab <- sampTab[order(as.character(sampTab[[column.ann]])),] + } Error: object 'column.ann' not found > > #clusters <- as.vector(object@sampTab$population) > #clusters <- as.vector(sampTab[[column.ann]]) > #names(clusters) <- rownames(sampTab) > #clusters <- clusters[order(clusters)] > ann_col <- sampTab[, c(column.ann, + column.ann2)]#data.frame(population=as.vector(clusters), stringsAsFactors = Error: object 'sampTab' not found > FALSE) Error: unexpected ')' in " FALSE)" > #rownames(ann_col) <- names(clusters) > > ann_row <- data.frame(signature=as.vector(markers2$population), + stringsAsFactors = FALSE) Error in as.vector(markers2$population) : object 'markers2' not found > rownames(ann_row) <- as.vector(markers2$gene) Error in as.vector(markers2$gene) : object 'markers2' not found > if(!is.null(order)){ + ann_col$population <- factor(ann_col$population, levels=order) + ann_row$signature <- factor(ann_row$signature, levels=order) + } Error in factor(ann_col$population, levels = order) : object 'ann_col' not found > > #colors <- cRampClust(cluster.vector, 8) > #names(colors) <- cluster.vector > colors <- unique(sampTab[[column.color]]) Error in unique(sampTab[[column.color]]) : object 'sampTab' not found > names(colors) <- unique(as.vector(sampTab[[column.ann]])) Error in as.vector(sampTab[[column.ann]]) : object 'sampTab' not found > > color_lists <- list(population=colors, signature=colors) > > #replicate_row <- as.vector(unlist(lapply(split(ann_row, > ann_row$signature), nrow))) Error: unexpected ')' in "ann_row$signature)" > #colors_row <- rep(colors, times=replicate_row) > #replicate_col <- as.vector(unlist(lapply(split(ann_col, > ann_col$population), nrow))) Error: unexpected ')' in "ann_col$population)" > #colors_col <- rep(colors, times=replicate_col) > index <- getIndexes(ann_col, ann_row, order.columns = + unique(ann_col$population), order.rows = unique(ann_row$signature)) Show Traceback Rerun with Debug Error in nrow(ann_col) : object 'ann_col' not found > > if(is.null(genes.show)){ + genes.show <- markers2 %>% group_by(population) %>% top_n(5, fc) + genes.show <- as.vector(genes.show$gene) + selected <- as.vector(markers2$gene) + selected[!(selected %in% genes.show)] <- "" + }else{ + selected <- as.vector(markers2$gene) + selected[!(selected %in% genes.show)] <- "" + } Error: object 'genes.show' not found > > pheatmap(matrix[rownames(ann_row),rownames(ann_col)], cluster_rows=FALSE, + cluster_cols=FALSE, color = myColor, breaks=myBreaks, fontsize=15, + #gaps_row = index$rowsep, + gaps_col = index$colsep, annotation_col = ann_col, + annotation_row = ann_row, annotation_colors = color_lists, + labels_row = selected, + labels_col = rep("", ncol(matrix)), width=width, height=height, + filename=filename) Error in pheatmap(matrix[rownames(ann_row), rownames(ann_col)], cluster_rows = FALSE, : object 'selected' not found > > > gc(verbose = FALSE) used (Mb) gc trigger (Mb) max used (Mb) Ncells 4058627 216.8 6353278 339.4 6353278 339.4 Vcells 1415607006 10800.3 3111833001 23741.5 2168651371 16545.5 > > } Error: unexpected '}' in "}" > plotSignaturesHeatmap2 <- function(object, markers, column.ann, + column.ann2, column.color, num.cells=NULL, threshold=2, genes.show=NULL, + low='purple', intermediate='black', + high='yellow', order=NULL, width, height, filename){ + + if(is.null(num.cells)){ + print('here') + cells.keep <- rownames(object@sampTab) + print(table(object@sampTab[[column.ann]])) + }else{ + #cells.use <- object@sampTab %>% group_by_(column.ann) %>% + sample_n(size = num.cells, replace = TRUE) + cells.use <- split(object@sampTab, object@sampTab[[column.ann]]) + cells.use <- lapply(cells.use, function(x){ + if(nrow(x) < num.cells){ + cells.use.x <- x[sample(rownames(x), size = nrow(x)),] + }else{ + cells.use.xx <- x[sample(rownames(x), size = num.cells),] + } + }) + cells.use.tmp <- do.call(rbind, cells.use) + cells.keep <- as.vector(cells.use.tmp$sample_id) + } + + #data <- object@ndata[,cells.use] + matrix <- center_with_threshold(object@ndata[,cells.keep], threshold) + + paletteLength <- 100 + #myColor <- colorRampPalette(c("purple","black","yellow"))(paletteLength) + myColor <- colorRampPalette(c(low, intermediate, high))(paletteLength) + myBreaks <- c(seq(min(matrix), 0, length.out=ceiling(paletteLength/2) + + 1), + seq(max(matrix)/paletteLength, max(matrix), + length.out=floor(paletteLength/2))) + + + library(data.table) + markers2 <- as.data.frame(markers) + #markers2 <- as.data.frame(markers) + #markers2 <- as.data.table(markers2)[, .SD[which.max(fc.column)], by=gene] + #markers2 <- as.data.frame(markers2) + #markers2 <- as.data.frame(markers) + #markers2 <- markers2[!duplicated(markers2$gene),] #need to make sure + there is no duplicated element... Error: unexpected symbol in: " #markers2 <- markers2[!duplicated(markers2$gene),] #need to make sure there is" > sampTab <- object@sampTab Error: object 'object' not found > sampTab <- sampTab[cells.keep,] Error: object 'sampTab' not found > > if(column.ann == 'population'){ + markers2 <- markers2[order(as.numeric(markers2$population)),] + rownames(markers2) <- as.vector(markers2$gene) + sampTab <- sampTab[order(as.numeric(sampTab$population)),] + }else if(!is.null(order)){ + markers2 <- markers2[order(factor(markers2$population, levels=order)),] + sampTab <- sampTab[order(factor(sampTab[[column.ann]], levels=order)),] + }else{ + markers2 <- markers2[order(as.character(markers2$population)),] + rownames(markers2) <- as.vector(markers2$gene) + sampTab <- sampTab[order(as.character(sampTab[[column.ann]])),] + } Error: object 'column.ann' not found > > #clusters <- as.vector(object@sampTab$population) > #clusters <- as.vector(sampTab[[column.ann]]) > #names(clusters) <- rownames(sampTab) > #clusters <- clusters[order(clusters)] > ann_col <- sampTab[, c(column.ann, + column.ann2)]#data.frame(population=as.vector(clusters), stringsAsFactors = Error: object 'sampTab' not found > FALSE) Error: unexpected ')' in " FALSE)" > #rownames(ann_col) <- names(clusters) > > ann_row <- data.frame(signature=as.vector(markers2$population), + stringsAsFactors = FALSE) Error in as.vector(markers2$population) : object 'markers2' not found > rownames(ann_row) <- as.vector(markers2$gene) Error in as.vector(markers2$gene) : object 'markers2' not found > if(!is.null(order)){ + ann_col$population <- factor(ann_col$population, levels=order) + ann_row$signature <- factor(ann_row$signature, levels=order) + } Error in factor(ann_col$population, levels = order) : object 'ann_col' not found > > #colors <- cRampClust(cluster.vector, 8) > #names(colors) <- cluster.vector > colors <- unique(sampTab[[column.color]]) Error in unique(sampTab[[column.color]]) : object 'sampTab' not found > names(colors) <- unique(as.vector(sampTab[[column.ann]])) Error in as.vector(sampTab[[column.ann]]) : object 'sampTab' not found > > color_lists <- list(population=colors, signature=colors) > > #replicate_row <- as.vector(unlist(lapply(split(ann_row, > ann_row$signature), nrow))) Error: unexpected ')' in "ann_row$signature)" > #colors_row <- rep(colors, times=replicate_row) > #replicate_col <- as.vector(unlist(lapply(split(ann_col, > ann_col$population), nrow))) Error: unexpected ')' in "ann_col$population)" > #colors_col <- rep(colors, times=replicate_col) > index <- getIndexes(ann_col, ann_row, order.columns = + unique(ann_col$population), order.rows = unique(ann_row$signature)) Show Traceback Rerun with Debug Error in nrow(ann_col) : object 'ann_col' not found > > if(is.null(genes.show)){ + genes.show <- markers2 %>% group_by(population) %>% top_n(5, fc) + genes.show <- as.vector(genes.show$gene) + selected <- as.vector(markers2$gene) + selected[!(selected %in% genes.show)] <- "" + }else{ + selected <- as.vector(markers2$gene) + selected[!(selected %in% genes.show)] <- "" + } Error: object 'genes.show' not found > > pheatmap(matrix[rownames(ann_row),rownames(ann_col)], cluster_rows=FALSE, + cluster_cols=FALSE, color = myColor, breaks=myBreaks, fontsize=15, + #gaps_row = index$rowsep, + gaps_col = index$colsep, annotation_col = ann_col, + annotation_row = ann_row, annotation_colors = color_lists, + labels_row = selected, + labels_col = rep("", ncol(matrix)), width=width, height=height, + filename=filename) Error in pheatmap(matrix[rownames(ann_row), rownames(ann_col)], cluster_rows = FALSE, : object 'selected' not found > > > gc(verbose = FALSE) used (Mb) gc trigger (Mb) max used (Mb) Ncells 4058627 216.8 6353278 339.4 6353278 339.4 Vcells 1415607006 10800.3 3111833001 23741.5 2168651371 16545.5 > > } Error: unexpected '}' in "}" --   | >