PSORIASIS SAMPLES - CONTINUED - PART 5

PSO + PSA + NORMAL SKIN COMBINED ANALYSIS

Integration with PS skin scRNA data from (dataset 2) Reynolds et al.

(DOI - https://doi.org/10.1126/science.aba6500).

LINK / FIG NO DESCRIPTION
[FIGURE 5A] Spatial plots for cell type enrichment using (PS only) data-set 2 (Reynolds et al.) - Structural cell types
[FIGURE 5B] MIA for (PS only) dataset 2 - Immune cell types
[FIGURE S9B] UMAP for (PS only) dataset 2
[FIGURE S9D] MIA for (PS only) dataset 2 - Structural cell types

LOAD ALL PACKAGES

library(tidyverse)
library(Seurat)
library(cowplot)
library(ggsci)
library(RColorBrewer)
library(pheatmap)
library(SeuratDisk)

LOAD HELPER FUNCTIONS

source("../SPATIAL_FUNCTIONS.R")

LOAD COLOR PALETTE USED FOR ALL PLOTS

col.pal <- RColorBrewer::brewer.pal(9, "OrRd")

Integration with dataset 1 (Hughes et al)

Importing Harmonized (Batch corrected) ST data (produced in PS Samples part 1 notebook).

# 1. All Spatial Samples with Harmony Batch Correction
skin_data.hm.sct <- readRDS(file = "/Volumes/Extreme Pro/GITHUB-DATA/ST-DATA/PSORIASIS-DATA/RDS-Files/ALL_SPATIAL_SAMPLES(HM_BATCH_CORRECTED).RDS")

# 2. Single Cell Markers
skin_data.hm.sct.markers <- readRDS("/Volumes/Extreme Pro/GITHUB-DATA/ST-DATA/PSORIASIS-DATA/RDS-Files/ALL_ST_HARMONY_ALIGNED_MARKERS.RDS")
## COLOR FOR LABELS
color.labels <- c("0 Fibroblasts"="#87CEFA",
"1 Macs + fibroblasts"="#4876FF",
"2 Eccrine + melanocyte precursors"="#CD853F",
"3 Epidermis"="#BF96FF",
"4 Epidermis"="#FF0000",
"5 Connective tissue"="#CAF178",
"6 Mixed"="#E0BFB6",
"7 Epidermis"="#68228B",
"8 Hair follicle and sebaceous glands"="#7B0000",
"9 Adipose"="#FFC71A",
"10 Suprabasal keratinocytes"="#C355A0",
"11 Smooth muscle"="#00B923",
"12 Endothelial cells"="#8B5A2B",
"13 Immunoglobulins, fibroblasts"="#838B8B",
"14 Smooth muscle"="#005947",
"15 Mixed"="#C1CDCD",
"16 Adipose, fibroblasts"="#FF7545")

Load data-set 2 (Reynolds et al.) scRNA data

library(SeuratDisk)
hnf.data <- LoadH5Seurat("/Volumes/Extreme Pro/GITHUB-DATA/SC-RNA-DATA/HANIFFA-DATA/RDS-Files/
                         submission.h5seurat",)

hnf.data.PS <- subset(hnf.data,Status %in% c("Psoriasis"))
hnf.data.PS <- NormalizeData(hnf.data.PS)
hnf.data.PS<- FindVariableFeatures(hnf.data.PS, selection.method = "vst", nfeatures = 2000)
hnf.data.PS<- ScaleData(hnf.data.PS)
hnf.data.PS<- RunPCA(hnf.data.PS, features = VariableFeatures(object = hnf.data.PS))
hnf.data.PS <- FindNeighbors(hnf.data.PS, dims = 1:40)
hnf.data.PS <- FindClusters(hnf.data.PS)
hnf.data.PS <- RunUMAP(hnf.data.PS, dims = 1:40)
saveRDS(hnf.data.PS,file="HNF_SC_RNA_PSORIASIS_DATA.RDS")
hnf.data.PS <- readRDS("/Volumes/Extreme Pro/GITHUB-DATA/SC-RNA-DATA/HANIFFA-DATA/RDS-Files/HNF_SC_RNA_PSORIASIS_DATA.RDS")
hnf.data.PS.subset <- subset(hnf.data.PS,final_clustering != c("nan"))
#pdf(width = 12,height=8,file = "UMAP_HANNIFA_DATA_PS_SAMPLES_ONLY.pdf")
DimPlot(hnf.data.PS.subset,group.by = "final_clustering",pt.size = 1.2,raster=FALSE)
#dev.off()
DimPlot(hnf.data.PS.subset,group.by = "final_clustering",pt.size = 1.2,raster=FALSE)
hnf.data.PS.subsampled <- hnf.data.PS.subset[, sample(colnames(hnf.data.PS.subset), size =25000, replace=F)]

pdf(width = 12,height=8,file = "UMAP_HANNIFA_DATA_PS_SAMPLES_ONLY(AFTER_DOWNSAMPLING).pdf")
DimPlot(hnf.data.PS.subsampled,group.by = "final_clustering",pt.size = 3.5,raster=FALSE)
dev.off()
Idents(hnf.data.PS) <- "final_clustering"
Marker_genes.HNF <- FindAllMarkers(hnf.data.PS,max.cells.per.ident=1000,min.pct = 0.25)

USING ALL SKIN ST DATA

filtered_single_cell.markers <- Marker_genes.HNF %>% filter(p_val_adj<=0.05) %>% group_by(cluster) %>% top_n(n =300,wt = avg_log2FC) %>% filter(avg_log2FC>0.25)
filtered_spatial_markers <- skin_data.hm.sct.markers %>% filter(p_val_adj<=0.05) %>% group_by(cluster) %>% top_n(n =300,wt = avg_log2FC) %>% filter(avg_log2FC>0.25)

##INTERSECT GENES BETWEEN scRNA and Spatial data
st.genes <- unique(rownames(skin_data.hm.sct@assays$Spatial@counts))
sc.genes <- unique(rownames(hnf.data.PS@assays$RNA@counts))
all.genes.scrna_and_spt <- unique(intersect(sc.genes,st.genes))

MIA_results <- MIA(total_genes = length(all.genes.scrna_and_spt),single_cell.markers = filtered_single_cell.markers,spatial.markers = filtered_spatial_markers)

E.data <- MIA_results %>% column_to_rownames("cluster")
E.data <- E.data[,order(colnames(E.data))]
pheatmap(E.data,cluster_cols = FALSE,cluster_rows = FALSE,fontsize=15,color = col.pal)
LS0tCnRpdGxlOiAiUFMgU0FNUExFUyBQQVJUIDUiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KClBTT1JJQVNJUyBTQU1QTEVTIC0gQ09OVElOVUVEIC0gUEFSVCA1CgpQU08gKyBQU0EgKyBOT1JNQUwgU0tJTiBDT01CSU5FRCBBTkFMWVNJUwoKSW50ZWdyYXRpb24gd2l0aCBQUyBza2luIHNjUk5BIGRhdGEgZnJvbSAoZGF0YXNldCAyKSBSZXlub2xkcyBldCBhbC4KCihET0kgLSBodHRwczovL2RvaS5vcmcvMTAuMTEyNi9zY2llbmNlLmFiYTY1MDApLgoKfCBMSU5LIC8gRklHIE5PIHwgREVTQ1JJUFRJT04gICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgfAp8LS0tLS0tLS0tLS0tLS0tLS0tLXwtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS18CnwgW0ZJR1VSRSA1QV0gICB8IFNwYXRpYWwgcGxvdHMgZm9yIGNlbGwgdHlwZSBlbnJpY2htZW50IHVzaW5nIChQUyBvbmx5KSBkYXRhLXNldCAyIChSZXlub2xkcyBldCBhbC4pIC0gU3RydWN0dXJhbCBjZWxsIHR5cGVzIHwKfCBbRklHVVJFIDVCXSAgIHwgTUlBIGZvciAoUFMgb25seSkgZGF0YXNldCAyIC0gSW1tdW5lIGNlbGwgdHlwZXMgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgfAp8IFtGSUdVUkUgUzlCXSAgfCBVTUFQIGZvciAoUFMgb25seSkgZGF0YXNldCAyICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB8CnwgW0ZJR1VSRSBTOURdICB8IE1JQSBmb3IgKFBTIG9ubHkpIGRhdGFzZXQgMiAtIFN0cnVjdHVyYWwgY2VsbCB0eXBlcyAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHwKCiMjIyBMT0FEIEFMTCBQQUNLQUdFUwoKYGBge3J9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KFNldXJhdCkKbGlicmFyeShjb3dwbG90KQpsaWJyYXJ5KGdnc2NpKQpsaWJyYXJ5KFJDb2xvckJyZXdlcikKbGlicmFyeShwaGVhdG1hcCkKbGlicmFyeShTZXVyYXREaXNrKQpgYGAKCiMjIyBMT0FEIEhFTFBFUiBGVU5DVElPTlMKCmBgYHtyfQpzb3VyY2UoIi4uL1NQQVRJQUxfRlVOQ1RJT05TLlIiKQpgYGAKCiMjIyBMT0FEIENPTE9SIFBBTEVUVEUgVVNFRCBGT1IgQUxMIFBMT1RTCgpgYGB7cn0KY29sLnBhbCA8LSBSQ29sb3JCcmV3ZXI6OmJyZXdlci5wYWwoOSwgIk9yUmQiKQpgYGAKCgojIyMgSW50ZWdyYXRpb24gd2l0aCBkYXRhc2V0IDEgKEh1Z2hlcyBldCBhbCkKCkltcG9ydGluZyBIYXJtb25pemVkIChCYXRjaCBjb3JyZWN0ZWQpIFNUIGRhdGEgKHByb2R1Y2VkIGluIFBTIFNhbXBsZXMgcGFydCAxIG5vdGVib29rKS4KCmBgYHtyfQojIDEuIEFsbCBTcGF0aWFsIFNhbXBsZXMgd2l0aCBIYXJtb255IEJhdGNoIENvcnJlY3Rpb24Kc2tpbl9kYXRhLmhtLnNjdCA8LSByZWFkUkRTKGZpbGUgPSAiL1ZvbHVtZXMvRXh0cmVtZSBQcm8vR0lUSFVCLURBVEEvU1QtREFUQS9QU09SSUFTSVMtREFUQS9SRFMtRmlsZXMvQUxMX1NQQVRJQUxfU0FNUExFUyhITV9CQVRDSF9DT1JSRUNURUQpLlJEUyIpCgojIDIuIFNpbmdsZSBDZWxsIE1hcmtlcnMKc2tpbl9kYXRhLmhtLnNjdC5tYXJrZXJzIDwtIHJlYWRSRFMoIi9Wb2x1bWVzL0V4dHJlbWUgUHJvL0dJVEhVQi1EQVRBL1NULURBVEEvUFNPUklBU0lTLURBVEEvUkRTLUZpbGVzL0FMTF9TVF9IQVJNT05ZX0FMSUdORURfTUFSS0VSUy5SRFMiKQpgYGAKCmBgYHtyfQojIyBDT0xPUiBGT1IgTEFCRUxTCmNvbG9yLmxhYmVscyA8LSBjKCIwIEZpYnJvYmxhc3RzIj0iIzg3Q0VGQSIsCiIxIE1hY3MgKyBmaWJyb2JsYXN0cyI9IiM0ODc2RkYiLAoiMiBFY2NyaW5lICsgbWVsYW5vY3l0ZSBwcmVjdXJzb3JzIj0iI0NEODUzRiIsCiIzIEVwaWRlcm1pcyI9IiNCRjk2RkYiLAoiNCBFcGlkZXJtaXMiPSIjRkYwMDAwIiwKIjUgQ29ubmVjdGl2ZSB0aXNzdWUiPSIjQ0FGMTc4IiwKIjYgTWl4ZWQiPSIjRTBCRkI2IiwKIjcgRXBpZGVybWlzIj0iIzY4MjI4QiIsCiI4IEhhaXIgZm9sbGljbGUgYW5kIHNlYmFjZW91cyBnbGFuZHMiPSIjN0IwMDAwIiwKIjkgQWRpcG9zZSI9IiNGRkM3MUEiLAoiMTAgU3VwcmFiYXNhbCBrZXJhdGlub2N5dGVzIj0iI0MzNTVBMCIsCiIxMSBTbW9vdGggbXVzY2xlIj0iIzAwQjkyMyIsCiIxMiBFbmRvdGhlbGlhbCBjZWxscyI9IiM4QjVBMkIiLAoiMTMgSW1tdW5vZ2xvYnVsaW5zLCBmaWJyb2JsYXN0cyI9IiM4MzhCOEIiLAoiMTQgU21vb3RoIG11c2NsZSI9IiMwMDU5NDciLAoiMTUgTWl4ZWQiPSIjQzFDRENEIiwKIjE2IEFkaXBvc2UsIGZpYnJvYmxhc3RzIj0iI0ZGNzU0NSIpCmBgYAoKTG9hZCBkYXRhLXNldCAyIChSZXlub2xkcyBldCBhbC4pIHNjUk5BIGRhdGEKYGBge3J9CmxpYnJhcnkoU2V1cmF0RGlzaykKYGBgCmBgYHtSLGV2YWw9RkFMU0V9CmhuZi5kYXRhIDwtIExvYWRINVNldXJhdCgiL1ZvbHVtZXMvRXh0cmVtZSBQcm8vR0lUSFVCLURBVEEvU0MtUk5BLURBVEEvSEFOSUZGQS1EQVRBL1JEUy1GaWxlcy8KICAgICAgICAgICAgICAgICAgICAgICAgIHN1Ym1pc3Npb24uaDVzZXVyYXQiLCkKCmhuZi5kYXRhLlBTIDwtIHN1YnNldChobmYuZGF0YSxTdGF0dXMgJWluJSBjKCJQc29yaWFzaXMiKSkKYGBgCgpgYGB7cixldmFsPUZBTFNFfQpobmYuZGF0YS5QUyA8LSBOb3JtYWxpemVEYXRhKGhuZi5kYXRhLlBTKQpobmYuZGF0YS5QUzwtIEZpbmRWYXJpYWJsZUZlYXR1cmVzKGhuZi5kYXRhLlBTLCBzZWxlY3Rpb24ubWV0aG9kID0gInZzdCIsIG5mZWF0dXJlcyA9IDIwMDApCmhuZi5kYXRhLlBTPC0gU2NhbGVEYXRhKGhuZi5kYXRhLlBTKQpobmYuZGF0YS5QUzwtIFJ1blBDQShobmYuZGF0YS5QUywgZmVhdHVyZXMgPSBWYXJpYWJsZUZlYXR1cmVzKG9iamVjdCA9IGhuZi5kYXRhLlBTKSkKaG5mLmRhdGEuUFMgPC0gRmluZE5laWdoYm9ycyhobmYuZGF0YS5QUywgZGltcyA9IDE6NDApCmhuZi5kYXRhLlBTIDwtIEZpbmRDbHVzdGVycyhobmYuZGF0YS5QUykKaG5mLmRhdGEuUFMgPC0gUnVuVU1BUChobmYuZGF0YS5QUywgZGltcyA9IDE6NDApCmBgYAoKYGBge3IsZXZhbD1GQUxTRX0Kc2F2ZVJEUyhobmYuZGF0YS5QUyxmaWxlPSJITkZfU0NfUk5BX1BTT1JJQVNJU19EQVRBLlJEUyIpCmBgYApgYGB7cn0KaG5mLmRhdGEuUFMgPC0gcmVhZFJEUygiL1ZvbHVtZXMvRXh0cmVtZSBQcm8vR0lUSFVCLURBVEEvU0MtUk5BLURBVEEvSEFOSUZGQS1EQVRBL1JEUy1GaWxlcy9ITkZfU0NfUk5BX1BTT1JJQVNJU19EQVRBLlJEUyIpCmBgYAoKYGBge3J9CmhuZi5kYXRhLlBTLnN1YnNldCA8LSBzdWJzZXQoaG5mLmRhdGEuUFMsZmluYWxfY2x1c3RlcmluZyAhPSBjKCJuYW4iKSkKYGBgCmBgYHtyfQojcGRmKHdpZHRoID0gMTIsaGVpZ2h0PTgsZmlsZSA9ICJVTUFQX0hBTk5JRkFfREFUQV9QU19TQU1QTEVTX09OTFkucGRmIikKRGltUGxvdChobmYuZGF0YS5QUy5zdWJzZXQsZ3JvdXAuYnkgPSAiZmluYWxfY2x1c3RlcmluZyIscHQuc2l6ZSA9IDEuMixyYXN0ZXI9RkFMU0UpCiNkZXYub2ZmKCkKYGBgCgpgYGB7cn0KRGltUGxvdChobmYuZGF0YS5QUy5zdWJzZXQsZ3JvdXAuYnkgPSAiZmluYWxfY2x1c3RlcmluZyIscHQuc2l6ZSA9IDEuMixyYXN0ZXI9RkFMU0UpCmBgYAoKYGBge3J9CmhuZi5kYXRhLlBTLnN1YnNhbXBsZWQgPC0gaG5mLmRhdGEuUFMuc3Vic2V0Wywgc2FtcGxlKGNvbG5hbWVzKGhuZi5kYXRhLlBTLnN1YnNldCksIHNpemUgPTI1MDAwLCByZXBsYWNlPUYpXQoKcGRmKHdpZHRoID0gMTIsaGVpZ2h0PTgsZmlsZSA9ICJVTUFQX0hBTk5JRkFfREFUQV9QU19TQU1QTEVTX09OTFkoQUZURVJfRE9XTlNBTVBMSU5HKS5wZGYiKQpEaW1QbG90KGhuZi5kYXRhLlBTLnN1YnNhbXBsZWQsZ3JvdXAuYnkgPSAiZmluYWxfY2x1c3RlcmluZyIscHQuc2l6ZSA9IDMuNSxyYXN0ZXI9RkFMU0UpCmRldi5vZmYoKQpgYGAKCmBgYHtyfQpJZGVudHMoaG5mLmRhdGEuUFMpIDwtICJmaW5hbF9jbHVzdGVyaW5nIgpNYXJrZXJfZ2VuZXMuSE5GIDwtIEZpbmRBbGxNYXJrZXJzKGhuZi5kYXRhLlBTLG1heC5jZWxscy5wZXIuaWRlbnQ9MTAwMCxtaW4ucGN0ID0gMC4yNSkKYGBgCiMgVVNJTkcgQUxMIFNLSU4gU1QgREFUQQpgYGB7cn0KZmlsdGVyZWRfc2luZ2xlX2NlbGwubWFya2VycyA8LSBNYXJrZXJfZ2VuZXMuSE5GICU+JSBmaWx0ZXIocF92YWxfYWRqPD0wLjA1KSAlPiUgZ3JvdXBfYnkoY2x1c3RlcikgJT4lIHRvcF9uKG4gPTMwMCx3dCA9IGF2Z19sb2cyRkMpICU+JSBmaWx0ZXIoYXZnX2xvZzJGQz4wLjI1KQpmaWx0ZXJlZF9zcGF0aWFsX21hcmtlcnMgPC0gc2tpbl9kYXRhLmhtLnNjdC5tYXJrZXJzICU+JSBmaWx0ZXIocF92YWxfYWRqPD0wLjA1KSAlPiUgZ3JvdXBfYnkoY2x1c3RlcikgJT4lIHRvcF9uKG4gPTMwMCx3dCA9IGF2Z19sb2cyRkMpICU+JSBmaWx0ZXIoYXZnX2xvZzJGQz4wLjI1KQoKIyNJTlRFUlNFQ1QgR0VORVMgQkVUV0VFTiBzY1JOQSBhbmQgU3BhdGlhbCBkYXRhCnN0LmdlbmVzIDwtIHVuaXF1ZShyb3duYW1lcyhza2luX2RhdGEuaG0uc2N0QGFzc2F5cyRTcGF0aWFsQGNvdW50cykpCnNjLmdlbmVzIDwtIHVuaXF1ZShyb3duYW1lcyhobmYuZGF0YS5QU0Bhc3NheXMkUk5BQGNvdW50cykpCmFsbC5nZW5lcy5zY3JuYV9hbmRfc3B0IDwtIHVuaXF1ZShpbnRlcnNlY3Qoc2MuZ2VuZXMsc3QuZ2VuZXMpKQoKTUlBX3Jlc3VsdHMgPC0gTUlBKHRvdGFsX2dlbmVzID0gbGVuZ3RoKGFsbC5nZW5lcy5zY3JuYV9hbmRfc3B0KSxzaW5nbGVfY2VsbC5tYXJrZXJzID0gZmlsdGVyZWRfc2luZ2xlX2NlbGwubWFya2VycyxzcGF0aWFsLm1hcmtlcnMgPSBmaWx0ZXJlZF9zcGF0aWFsX21hcmtlcnMpCgpFLmRhdGEgPC0gTUlBX3Jlc3VsdHMgJT4lIGNvbHVtbl90b19yb3duYW1lcygiY2x1c3RlciIpCkUuZGF0YSA8LSBFLmRhdGFbLG9yZGVyKGNvbG5hbWVzKEUuZGF0YSkpXQpwaGVhdG1hcChFLmRhdGEsY2x1c3Rlcl9jb2xzID0gRkFMU0UsY2x1c3Rlcl9yb3dzID0gRkFMU0UsZm9udHNpemU9MTUsY29sb3IgPSBjb2wucGFsKQpgYGAKCiMjIEFERCBIWVBFUkxJTksKYGBge3J9CmltbXVuZV9vbmx5LkUuZGF0YSA8LSBFLmRhdGFbLGMoIkRDMSIsIkRDMiIsIk1hY3JvXzEiLCJNYWNyb18yIiwibW9EQ18xIiwibW9EQ18yIiwibW9EQ18zIiwiTWlnREMiLCJNb25vIiwiSW5mX21vbm8iLCJJTEMxX05LIiwiSUxDMiIsIklMQzFfMyIsIklMQzIiLCJUYyIsIlRoIiwiVHJlZyIsIk1hc3RfY2VsbCIsIlBsYXNtYSIsIk5LIildCnBkZihmaWxlID0gIk1JQV9yZWdpb25zX0lNTVVORV9DRUxMU19IQU5JRkZBX0RBVEEucGRmIix3aWR0aCA9IDEwLGhlaWdodCA9IDEwKQpwaGVhdG1hcChpbW11bmVfb25seS5FLmRhdGEsY2x1c3Rlcl9jb2xzID0gRkFMU0UsY2x1c3Rlcl9yb3dzID0gRkFMU0UsZm9udHNpemU9MTUsY29sb3IgPSBjb2wucGFsKQpkZXYub2ZmKCkKYGBgCgpgYGB7cn0Kc3RydWN0dXJlX29ubHkuRV9kYXRhIDwtIEUuZGF0YSAlPiUgZHBseXI6OnNlbGVjdCgtYygiREMxIiwiREMyIiwiTWFjcm9fMSIsIk1hY3JvXzIiLCJtb0RDXzEiLCJtb0RDXzIiLCJtb0RDXzMiLCJNaWdEQyIsIk1vbm8iLCJJbmZfbW9ubyIsIklMQzFfTksiLCJJTEMyIiwiSUxDMV8zIiwiSUxDMiIsIlRjIiwiVGgiLCJUcmVnIiwiTWFzdF9jZWxsIiwiUGxhc21hIiwiTksiLCJuYW4iKSkKI3BkZihmaWxlID0gIk1JQV9yZWdpb25zX1NUUlVDVFVSQUxfQ0VMTFNfSEFOSUZGQV9EQVRBLnBkZiIsd2lkdGggPSAxMCxoZWlnaHQgPSAxMCkKcGhlYXRtYXAoc3RydWN0dXJlX29ubHkuRV9kYXRhLGNsdXN0ZXJfY29scyA9IEZBTFNFLGNsdXN0ZXJfcm93cyA9IEZBTFNFLGZvbnRzaXplPTE1LGNvbG9yID0gY29sLnBhbCkKI2Rldi5vZmYoKQpgYGAKCg==