Loading Libraries
library(rPanglaoDB)
library(Seurat)
library(harmony)
library(Nebulosa)
library(ggplot2)
library(ggrepel)
library(fgsea)
library(GSVA)
library(statsExpressions)
BIOP <- gmtPathways('https://maayanlab.cloud/Enrichr/geneSetLibrary?mode=text&libraryName=BioPlanet_2019')
FibrocytesClusters <- getMarkers(
include = c('ACTA2','CD34', 'COL5A1', 'COL5A2', 'COL5A3', 'FAP'),
exclude = 'CSF1R')
FibrocytesClusters
FibrocytesCounts <- getSamples(tissue = 'Dermis', specie = 'Mus musculus', celltype = 'Fibroblasts')
| | 0 % ~calculating
|+++++++++++++++++++++++++ | 50% ~54s
|++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=01m 26s
FibrocytesCounts <- NormalizeData(FibrocytesCounts, verbose = FALSE)
FibrocytesCounts <- ScaleData(FibrocytesCounts, verbose = FALSE)
FibrocytesCounts <- FindVariableFeatures(FibrocytesCounts, verbose = FALSE)
FibrocytesCounts <- RunPCA(FibrocytesCounts, verbose = FALSE)
FibrocytesCounts <- RunHarmony(FibrocytesCounts,
group.by.vars = 'orig.ident',
max.iter.harmony = 50,
verbose = FALSE)
FibrocytesCounts <- RunTSNE(FibrocytesCounts, reduction = 'harmony', dims = 1:10)
TSNEPlot(FibrocytesCounts) + theme_bw() + xlab('t-SNE 1') + ylab('t-SNE 2')

FibrocytesCounts <- FindNeighbors(FibrocytesCounts, reduction = 'harmony', verbose = FALSE)
FibrocytesCounts <- FindClusters(FibrocytesCounts, verbose = FALSE)
TSNEPlot(FibrocytesCounts, label = TRUE) + theme_bw() + xlab('t-SNE 1') + ylab('t-SNE 2') + theme(legend.position = 'None')

plot_density(object = FibrocytesCounts,
features = c('ACTA2','CD34', 'COL5A1', 'COL5A2', 'COL5A3', 'FAP'),
joint = FALSE)

P <- plot_density(object = FibrocytesCounts,
features = c('ACTA2','CD34', 'COL5A1', 'COL5A2', 'COL5A3', 'FAP'),
joint = TRUE)
P[[7]] + theme_bw() + xlab('t-SNE 1') + ylab('t-SNE 2') + theme(legend.position = 'None')

DotPlot(object = FibrocytesCounts,
features = c('ACTA2','CD34', 'COL5A1', 'COL5A2', 'COL5A3', 'FAP')) +
coord_flip()

table(Idents(FibrocytesCounts))
0 1 2 3 4 5 6 7 8 9 10 11 12
253 249 244 218 200 195 163 163 157 111 87 79 53
deFibrocytes <- FindMarkers(object = FibrocytesCounts, ident.1 = 8, test.use = 'MAST', verbose = FALSE)
deFibrocytes$g <- rownames(deFibrocytes)
deFibrocytes$g[abs(deFibrocytes$avg_log2FC) < 1] <- NA
deFibrocytes$F <- log2(deFibrocytes$pct.1/deFibrocytes$pct.2)
deFibrocytes$g[abs(deFibrocytes$F) < 1] <- NA
deFibrocytes$color <- 'black'
deFibrocytes$color[deFibrocytes$avg_log2FC > 1] <- 'red'
deFibrocytes$color[deFibrocytes$avg_log2FC < -1] <- 'blue'
ggplot(deFibrocytes, mapping = aes(avg_log2FC, -log10(p_val), label = g)) +
geom_point(color = deFibrocytes$color, alpha = 0.5) +
geom_text_repel() +
theme_bw() + xlab(log[2]~(Avg~Fold-change)) +
ylab(-log[10]~(P-value))

log2FC <- deFibrocytes$avg_log2FC
names(log2FC) <- rownames(deFibrocytes)
enrichmentFibrocytes <- fgseaMultilevel(BIOP, log2FC)
enrichmentFibrocytes <- enrichmentFibrocytes[enrichmentFibrocytes$padj < 0.05,]
enrichmentFibrocytes$leadingEdge <- unlist(lapply(enrichmentFibrocytes$leadingEdge, function(X){paste0(X, collapse = ';')}))
enrichmentFibrocytes[order(enrichmentFibrocytes$NES, decreasing = TRUE),]
sseBIOP <- gsva(as.matrix(FibrocytesCounts@assays$RNA@data), BIOP, method = 'ssgsea')
cellType <- ifelse(FibrocytesCounts$seurat_clusters %in% 8, 'Fibrocytes', 'Fibroblasts')
esFibrocytes <- data.frame(ES = sseBIOP['Prostaglandin biosynthesis and regulation',], CT = cellType)
ggplot(esFibrocytes, aes(CT, ES)) +
geom_violin() +
geom_boxplot(width = 0.1) +
theme_bw() +
xlab('Cell Type') +
ylab('Enrichment Score') +
labs(title = 'Prostaglandin biosynthesis and regulation',
subtitle = expr_t_nonparametric(esFibrocytes, CT, ES))

LS0tDQp0aXRsZTogJ0FwcGxpY2F0aW9uIENhc2UgMTogRmlicm9jeXRlcycNCm91dHB1dDoNCiAgaHRtbF9ub3RlYm9vazogZGVmYXVsdA0KLS0tDQoNCiMjIyBMb2FkaW5nIExpYnJhcmllcw0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmxpYnJhcnkoclBhbmdsYW9EQikNCmxpYnJhcnkoU2V1cmF0KQ0KbGlicmFyeShoYXJtb255KQ0KbGlicmFyeShOZWJ1bG9zYSkNCmxpYnJhcnkoZ2dwbG90MikNCmxpYnJhcnkoZ2dyZXBlbCkNCmxpYnJhcnkoZmdzZWEpDQpsaWJyYXJ5KEdTVkEpDQpsaWJyYXJ5KHN0YXRzRXhwcmVzc2lvbnMpDQpCSU9QIDwtIGdtdFBhdGh3YXlzKCdodHRwczovL21hYXlhbmxhYi5jbG91ZC9FbnJpY2hyL2dlbmVTZXRMaWJyYXJ5P21vZGU9dGV4dCZsaWJyYXJ5TmFtZT1CaW9QbGFuZXRfMjAxOScpDQpgYGANCg0KYGBge3J9DQpGaWJyb2N5dGVzQ2x1c3RlcnMgPC0gZ2V0TWFya2VycygNCiAgaW5jbHVkZSA9IGMoJ0FDVEEyJywnQ0QzNCcsICdDT0w1QTEnLCAnQ09MNUEyJywgJ0NPTDVBMycsICdGQVAnKSwgDQogIGV4Y2x1ZGUgPSAnQ1NGMVInKQ0KDQpGaWJyb2N5dGVzQ2x1c3RlcnMNCmBgYA0KYGBge3J9DQpGaWJyb2N5dGVzQ291bnRzIDwtIGdldFNhbXBsZXModGlzc3VlID0gJ0Rlcm1pcycsIHNwZWNpZSA9ICdNdXMgbXVzY3VsdXMnLCBjZWxsdHlwZSA9ICdGaWJyb2JsYXN0cycpDQpgYGANCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQpGaWJyb2N5dGVzQ291bnRzIDwtIE5vcm1hbGl6ZURhdGEoRmlicm9jeXRlc0NvdW50cywgdmVyYm9zZSA9IEZBTFNFKQ0KRmlicm9jeXRlc0NvdW50cyA8LSBTY2FsZURhdGEoRmlicm9jeXRlc0NvdW50cywgdmVyYm9zZSA9IEZBTFNFKQ0KRmlicm9jeXRlc0NvdW50cyA8LSBGaW5kVmFyaWFibGVGZWF0dXJlcyhGaWJyb2N5dGVzQ291bnRzLCB2ZXJib3NlID0gRkFMU0UpDQpGaWJyb2N5dGVzQ291bnRzIDwtIFJ1blBDQShGaWJyb2N5dGVzQ291bnRzLCB2ZXJib3NlID0gRkFMU0UpDQpGaWJyb2N5dGVzQ291bnRzIDwtIFJ1bkhhcm1vbnkoRmlicm9jeXRlc0NvdW50cywgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZ3JvdXAuYnkudmFycyA9ICdvcmlnLmlkZW50JywgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbWF4Lml0ZXIuaGFybW9ueSA9IDUwLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB2ZXJib3NlID0gRkFMU0UpDQpGaWJyb2N5dGVzQ291bnRzIDwtIFJ1blRTTkUoRmlicm9jeXRlc0NvdW50cywgcmVkdWN0aW9uID0gJ2hhcm1vbnknLCBkaW1zID0gMToxMCkNClRTTkVQbG90KEZpYnJvY3l0ZXNDb3VudHMpICsgdGhlbWVfYncoKSArIHhsYWIoJ3QtU05FIDEnKSArIHlsYWIoJ3QtU05FIDInKQ0KYGBgDQoNCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQpGaWJyb2N5dGVzQ291bnRzIDwtIEZpbmROZWlnaGJvcnMoRmlicm9jeXRlc0NvdW50cywgcmVkdWN0aW9uID0gJ2hhcm1vbnknLCB2ZXJib3NlID0gRkFMU0UpDQpGaWJyb2N5dGVzQ291bnRzIDwtIEZpbmRDbHVzdGVycyhGaWJyb2N5dGVzQ291bnRzLCB2ZXJib3NlID0gRkFMU0UpDQpUU05FUGxvdChGaWJyb2N5dGVzQ291bnRzLCBsYWJlbCA9IFRSVUUpICsgdGhlbWVfYncoKSArIHhsYWIoJ3QtU05FIDEnKSArIHlsYWIoJ3QtU05FIDInKSArIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICdOb25lJykNCmBgYA0KDQoNCmBgYHtyIGZpZy5oZWlnaHQ9NSwgZmlnLndpZHRoPTEwfQ0KcGxvdF9kZW5zaXR5KG9iamVjdCA9IEZpYnJvY3l0ZXNDb3VudHMsIA0KICAgICAgICAgICAgIGZlYXR1cmVzID0gYygnQUNUQTInLCdDRDM0JywgJ0NPTDVBMScsICdDT0w1QTInLCAnQ09MNUEzJywgJ0ZBUCcpLCANCiAgICAgICAgICAgICBqb2ludCA9IEZBTFNFKQ0KYGBgDQpgYGB7ciBmaWcuaGVpZ2h0PTUsIGZpZy53aWR0aD02fQ0KUCA8LSBwbG90X2RlbnNpdHkob2JqZWN0ID0gRmlicm9jeXRlc0NvdW50cywgDQogICAgICAgICAgICAgICAgICBmZWF0dXJlcyA9IGMoJ0FDVEEyJywnQ0QzNCcsICdDT0w1QTEnLCAnQ09MNUEyJywgJ0NPTDVBMycsICdGQVAnKSwgDQogICAgICAgICAgICAgICAgICBqb2ludCA9IFRSVUUpDQpQW1s3XV0gKyB0aGVtZV9idygpICsgeGxhYigndC1TTkUgMScpICsgeWxhYigndC1TTkUgMicpICsgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gJ05vbmUnKQ0KYGBgDQoNCmBgYHtyfQ0KRG90UGxvdChvYmplY3QgPSBGaWJyb2N5dGVzQ291bnRzLCANCiAgICAgICAgZmVhdHVyZXMgPSBjKCdBQ1RBMicsJ0NEMzQnLCAnQ09MNUExJywgJ0NPTDVBMicsICdDT0w1QTMnLCAnRkFQJykpICsgDQogIGNvb3JkX2ZsaXAoKQ0KYGBgDQpgYGB7cn0NCnRhYmxlKElkZW50cyhGaWJyb2N5dGVzQ291bnRzKSkNCmBgYA0KYGBge3IgbWVzc2FnZT1UUlVFLCB3YXJuaW5nPUZBTFNFLCByZXN1bHRzPSBGQUxTRX0NCmRlRmlicm9jeXRlcyA8LSBGaW5kTWFya2VycyhvYmplY3QgPSBGaWJyb2N5dGVzQ291bnRzLCBpZGVudC4xID0gOCwgdGVzdC51c2UgPSAnTUFTVCcsIHZlcmJvc2UgPSBGQUxTRSkNCmBgYA0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmRlRmlicm9jeXRlcyRnIDwtIHJvd25hbWVzKGRlRmlicm9jeXRlcykNCmRlRmlicm9jeXRlcyRnW2FicyhkZUZpYnJvY3l0ZXMkYXZnX2xvZzJGQykgPCAxXSA8LSBOQQ0KZGVGaWJyb2N5dGVzJEYgPC0gbG9nMihkZUZpYnJvY3l0ZXMkcGN0LjEvZGVGaWJyb2N5dGVzJHBjdC4yKQ0KZGVGaWJyb2N5dGVzJGdbYWJzKGRlRmlicm9jeXRlcyRGKSA8IDFdIDwtIE5BDQpkZUZpYnJvY3l0ZXMkY29sb3IgPC0gJ2JsYWNrJw0KZGVGaWJyb2N5dGVzJGNvbG9yW2RlRmlicm9jeXRlcyRhdmdfbG9nMkZDID4gMV0gPC0gJ3JlZCcNCmRlRmlicm9jeXRlcyRjb2xvcltkZUZpYnJvY3l0ZXMkYXZnX2xvZzJGQyA8IC0xXSA8LSAnYmx1ZScNCmdncGxvdChkZUZpYnJvY3l0ZXMsIG1hcHBpbmcgPSBhZXMoYXZnX2xvZzJGQywgLWxvZzEwKHBfdmFsKSwgbGFiZWwgPSBnKSkgKyANCiAgZ2VvbV9wb2ludChjb2xvciA9IGRlRmlicm9jeXRlcyRjb2xvciwgYWxwaGEgPSAwLjUpICsgDQogIGdlb21fdGV4dF9yZXBlbCgpICsgDQogIHRoZW1lX2J3KCkgKyB4bGFiKGxvZ1syXX4oQXZnfkZvbGQtY2hhbmdlKSkgKw0KICB5bGFiKC1sb2dbMTBdfihQLXZhbHVlKSkNCg0KYGBgDQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KbG9nMkZDIDwtIGRlRmlicm9jeXRlcyRhdmdfbG9nMkZDDQpuYW1lcyhsb2cyRkMpIDwtIHJvd25hbWVzKGRlRmlicm9jeXRlcykNCmVucmljaG1lbnRGaWJyb2N5dGVzIDwtIGZnc2VhTXVsdGlsZXZlbChCSU9QLCBsb2cyRkMpDQplbnJpY2htZW50Rmlicm9jeXRlcyA8LSBlbnJpY2htZW50Rmlicm9jeXRlc1tlbnJpY2htZW50Rmlicm9jeXRlcyRwYWRqIDwgMC4wNSxdDQplbnJpY2htZW50Rmlicm9jeXRlcyRsZWFkaW5nRWRnZSA8LSB1bmxpc3QobGFwcGx5KGVucmljaG1lbnRGaWJyb2N5dGVzJGxlYWRpbmdFZGdlLCBmdW5jdGlvbihYKXtwYXN0ZTAoWCwgY29sbGFwc2UgPSAnOycpfSkpDQplbnJpY2htZW50Rmlicm9jeXRlc1tvcmRlcihlbnJpY2htZW50Rmlicm9jeXRlcyRORVMsIGRlY3JlYXNpbmcgPSBUUlVFKSxdDQpgYGANCg0KYGBge3IsIHdhcm5pbmc9RkFMU0UsIHJlc3VsdHM9IEZBTFNFfQ0Kc3NlQklPUCA8LSBnc3ZhKGFzLm1hdHJpeChGaWJyb2N5dGVzQ291bnRzQGFzc2F5cyRSTkFAZGF0YSksIEJJT1AsIG1ldGhvZCA9ICdzc2dzZWEnKQ0KYGBgDQpgYGB7cn0NCmNlbGxUeXBlIDwtIGlmZWxzZShGaWJyb2N5dGVzQ291bnRzJHNldXJhdF9jbHVzdGVycyAlaW4lIDgsICdGaWJyb2N5dGVzJywgJ0ZpYnJvYmxhc3RzJykNCmVzRmlicm9jeXRlcyA8LSBkYXRhLmZyYW1lKEVTID0gc3NlQklPUFsnUHJvc3RhZ2xhbmRpbiBiaW9zeW50aGVzaXMgYW5kIHJlZ3VsYXRpb24nLF0sIENUID0gY2VsbFR5cGUpDQpnZ3Bsb3QoZXNGaWJyb2N5dGVzLCBhZXMoQ1QsIEVTKSkgKyANCiAgZ2VvbV92aW9saW4oKSArIA0KICBnZW9tX2JveHBsb3Qod2lkdGggPSAwLjEpICsgDQogIHRoZW1lX2J3KCkgKw0KICB4bGFiKCdDZWxsIFR5cGUnKSArDQogIHlsYWIoJ0VucmljaG1lbnQgU2NvcmUnKSArDQogIGxhYnModGl0bGUgPSAnUHJvc3RhZ2xhbmRpbiBiaW9zeW50aGVzaXMgYW5kIHJlZ3VsYXRpb24nLCANCiAgICAgICBzdWJ0aXRsZSA9IGV4cHJfdF9ub25wYXJhbWV0cmljKGVzRmlicm9jeXRlcywgQ1QsIEVTKSkNCmBgYA0K