# TODO: Add comment # # Author: E.Korsching 2024 ############################################################################### #### special plots for alignment-counting tables special.cl.tsne.mds <- function(x, outpathname, main=""){ # visualization of the group structure of a counting table with many samples (columns) # x: counting table # outpathname: workspace place + file name + file name extension # main: main title # might need:: adjustment of function itself (colors etc.) source("../0functions/cluster/color.groups.R") source("../0functions/cluster/agnes.cl.R") source("../0functions/cluster/f.tsne.R") source("../0functions/cluster/f.mds.R") source("../0functions/perm02/dvs.R") source("../0functions/0general/write2PDF.R") source("../proxyRela2/functions01.R") source("../proxyRela2/0trash.R") # needs:: set-column-name groups (char vectors) in the .GlobalEnv environment -- see below e.g. k.p.thal.first, ... # a.d1.c1 <- k.p.thal.first # a: affected, n: normal, d:disease type, c: cohort id (replication groups), o.X: other samples (not a,n) # n.d1.c1 <- k.n.thal.first # a.d1.c2 <- k.p.thal.second # n.d1.c2 <- k.n.thal.second # a.d1.c3 <- k.p.thal.third # n.d1.c3 <- k.n.thal.third # o.1 <- k.Npn.thal$gray # # a.d2.c1 <- k.p.an.first # n.d2.c1 <- k.n.an.first # a.d2.c2 <- k.p.an.second # n.d2.c2 <- k.n.an.second # o.2 <- k.Npn.an$gray # # a.d3.c1 <- k.p.mos.first # n.d3.c1 <- k.n.mos.first # a.d3.c2 <- k.p.mos.second # n.d3.c2 <- k.n.mos.second # o.3 <- k.Npn.mos$gray a.d1.c1 <- k2.a.th.first # a: affected, n: normal, d:disease type, c: cohort id (replication groups), o.X: other samples (not a,n) n.d1.c1 <- k2.n.th.first a.d1.c2 <- k2.a.th.second n.d1.c2 <- k2.n.th.second a.d1.c3 <- k2.a.th.third n.d1.c3 <- k2.n.th.third o.1 <- k2.Nan.th$gray a.d2.c1 <- k2.a.an.first n.d2.c1 <- k2.n.an.first a.d2.c2 <- k2.a.an.second n.d2.c2 <- k2.n.an.second o.2 <- k2.Nan.an$gray a.d3.c1 <- k2.a.mo.first n.d3.c1 <- k2.n.mo.first a.d3.c2 <- k2.a.mo.second n.d3.c2 <- k2.n.mo.second o.3 <- k2.Nan.mo$gray pdf(outpathname, width=11, height=7) aaa <- NULL; aaz <- 1 # content, real line counter aaa <- rbind(aaa, c(main, aaz, 0) ) aaz <- aaz+2 # empty line aaa <- rbind(aaa, c(paste("Hierarchical clustering, dissimilarity based - Pearson correlation (cor)",collapse=", "), aaz, 0) ) aaz <- aaz+3 # empty line aaa <- rbind(aaa, c(paste("Thalassemia: first, second, third, other: gray",collapse=""), aaz, 0) ) aaz <- aaz+2 aaa <- rbind(aaa, c(paste("Aneuploid: first, second, other: gray",collapse=""), aaz, 0) ) aaz <- aaz+2 aaa <- rbind(aaa, c(paste("Mosaic: first, second, other: gray",collapse=""), aaz, 0) ) write2PDF(aaa, add=F, col="black", cex=1.0, txt.lines=40, txt.width=50) legend("topright", legend=c("Thalassemia first A","Thalassemia first N","Thalassemia second A","Thalassemia second N","Thalassemia third A","Thalassemia third N","other", "Aneuploid first A","Aneuploid first N","Aneuploid second A","Aneuploid second N","other", "Mosaic first A","Mosaic first N","Mosaic second A","Mosaic second N","other"), col=c("deepskyblue1","blue1","chartreuse1","chartreuse4","tan1","tan3","gray", "deepskyblue1","blue1","chartreuse1","chartreuse4","gray", "deepskyblue1","blue1","chartreuse1","chartreuse4","gray"), text.col=c("deepskyblue1","blue1","chartreuse1","chartreuse4","tan1","tan3","gray", "deepskyblue1","blue1","chartreuse1","chartreuse4","gray", "deepskyblue1","blue1","chartreuse1","chartreuse4","gray"), pch=c(19,19,19,19,19,19,19), bg="gray90") #lty=c(1,1,1,1,1,1,1), # agnes all a1 <- dimnames(x)[[2]] a2 <- color.corresponding(a1, c("deepskyblue1","blue1","chartreuse1","chartreuse4","tan1","tan3","gray"), a.d1.c1,n.d1.c1, a.d1.c2,n.d1.c2, a.d1.c3,n.d1.c3, o.1) # thal a3 <- color.corresponding(a1, c("deepskyblue1","blue1","chartreuse1","chartreuse4","gray"), a.d2.c1,n.d2.c1, a.d2.c2,n.d2.c2, o.2) # an a4 <- color.corresponding(a1, c("deepskyblue1","blue1","chartreuse1","chartreuse4","gray"), a.d3.c1,n.d3.c1, a.d3.c2,n.d3.c2, o.3) # mos agnes.cl(x=x, ttext="Thalassemia", dissmat="L2", cl.method="average", col=a2, cex=0.8, plot=T, return=F) agnes.cl(x=x, ttext="Thalassemia", dissmat="eu", cl.method="average", col=a2, cex=0.8, plot=T, return=F) agnes.cl(x=x, ttext="Aneuploid", dissmat="L2", cl.method="average", col=a3, cex=0.8, plot=T, return=F) agnes.cl(x=x, ttext="Aneuploid", dissmat="eu", cl.method="average", col=a3, cex=0.8, plot=T, return=F) agnes.cl(x=x, ttext="Mosaic", dissmat="L2", cl.method="average", col=a4, cex=0.8, plot=T, return=F) agnes.cl(x=x, ttext="Mosaic", dissmat="eu", cl.method="average", col=a4, cex=0.8, plot=T, return=F) # agnes only group samples a12 <- x[,c(a.d1.c1,n.d1.c1, a.d1.c2,n.d1.c2, a.d1.c3,n.d1.c3)] a21 <- color.corresponding(c(a.d1.c1,n.d1.c1, a.d1.c2,n.d1.c2, a.d1.c3,n.d1.c3), c("deepskyblue1","blue1","chartreuse1","chartreuse4","tan1","tan3"), a.d1.c1,n.d1.c1, a.d1.c2,n.d1.c2, a.d1.c3,n.d1.c3) # thal a13 <- x[,c(a.d2.c1,n.d2.c1, a.d2.c2,n.d2.c2)] a31 <- color.corresponding(c(a.d2.c1,n.d2.c1, a.d2.c2,n.d2.c2), c("deepskyblue1","blue1","chartreuse1","chartreuse4"), a.d2.c1,n.d2.c1, a.d2.c2,n.d2.c2) # an a14 <- x[,c(a.d3.c1,n.d3.c1, a.d3.c2,n.d3.c2)] a41 <- color.corresponding(c(a.d3.c1,n.d3.c1, a.d3.c2,n.d3.c2), c("deepskyblue1","blue1","chartreuse1","chartreuse4"), a.d3.c1,n.d3.c1, a.d3.c2,n.d3.c2) # mos #ab <- dimnames(a)[[2]] #ac <- c(a.d1.c1,a.d1.c2,a.d1.c3, n.d1.c1,n.d1.c2,n.d1.c3,o.1) #ad <- iu.set(list(ab,ac), idv=c(0,0),setfn="ue") #ac <- c(a.d2.c1,n.d2.c1,a.d2.c2,n.d2.c2) #ad <- iu.set(list(ab=ab,ac=ac),idv=c(0,0), setfn="ue") #ac <- c(a.d3.c1,n.d3.c1,a.d3.c2,n.d3.c2) #ad <- iu.set(list(ab=ab,ac=ac),idv=c(0,0), setfn="ue") agnes.cl(x=a12, ttext="Thalassemia", dissmat="L2", cl.method="average", col=a21, cex=0.8, plot=T, return=F) agnes.cl(x=a12, ttext="Thalassemia", dissmat="eu", cl.method="average", col=a21, cex=0.8, plot=T, return=F) agnes.cl(x=a13, ttext="Aneuploid", dissmat="L2", cl.method="average", col=a31, cex=0.8, plot=T, return=F) agnes.cl(x=a13, ttext="Aneuploid", dissmat="eu", cl.method="average", col=a31, cex=0.8, plot=T, return=F) agnes.cl(x=a14, ttext="Mosaic", dissmat="L2", cl.method="average", col=a41, cex=0.8, plot=T, return=F) agnes.cl(x=a14, ttext="Mosaic", dissmat="eu", cl.method="average", col=a41, cex=0.8, plot=T, return=F) # tsne all se.se <- 376 aa <- t( as.matrix(x[,c(a.d1.c1,a.d1.c2,a.d1.c3, o.1, n.d1.c1,n.d1.c2,n.d1.c3)]) ) ab <- factor( c(rep("th1a",length(a.d1.c1)),rep("th2a",length(a.d1.c2)),rep("th3a",length(a.d1.c3)),rep("other",length(o.1)), rep("th1n",length(n.d1.c1)),rep("th2n",length(n.d1.c2)),rep("th3n",length(n.d1.c3)) ), levels=c("th1a","th2a","th3a","other","th1n","th2n","th3n") ) ac <- color.groups(c("deepskyblue1","chartreuse1","tan1","gray","blue1","chartreuse4","tan3"), a.d1.c1,a.d1.c2,a.d1.c3, o.1, n.d1.c1,n.d1.c2,n.d1.c3) ad <- rep(20,length(ac)) f.tsne(mat=aa, lv=ab, col=ac, psym=ad, pp=3, se.se=se.se, text=F, title=paste("Thalassemia, raw, seed ",se.se,sep=""), lpos="bottomleft") aa <- t( as.matrix(x[,c(a.d2.c1,a.d2.c2, o.2, n.d2.c1,n.d2.c2)]) ) ab <- factor( c(rep("an1a",length(a.d2.c1)),rep("an2a",length(a.d2.c2)),rep("other",length(o.2)), rep("an1n",length(n.d2.c1)),rep("an2n",length(n.d2.c2)) ), levels=c("an1a","an2a","other","an1n","an2n") ) ac <- color.groups(c("deepskyblue1","chartreuse1","gray","blue1","chartreuse4"), a.d2.c1,a.d2.c2, o.2, n.d2.c1,n.d2.c2) ad <- rep(20,length(ac)) f.tsne(mat=aa, lv=ab, col=ac, psym=ad, pp=3, se.se=se.se, text=F, title=paste("Aneuploidy, raw, seed ",se.se,sep=""), lpos="bottomleft") aa <- t( as.matrix(x[,c(a.d3.c1,a.d3.c2, o.3, n.d3.c1,n.d3.c2)]) ) ab <- factor( c(rep("mo1a",length(a.d3.c1)),rep("mo2a",length(a.d3.c2)),rep("other",length(o.3)), rep("mo1n",length(n.d3.c1)),rep("mo2n",length(n.d3.c2)) ), levels=c("mo1a","mo2a","other","mo1n","mo2n") ) ac <- color.groups(c("deepskyblue1","chartreuse1","gray","blue1","chartreuse4"), a.d3.c1,a.d3.c2, o.3, n.d3.c1,n.d3.c2) ad <- rep(20,length(ac)) f.tsne(mat=aa, lv=ab, col=ac, psym=ad, pp=3, se.se=se.se, text=F, title=paste("Mosaic, raw, seed ",se.se,sep=""), lpos="bottomleft") # tsne only group samples se.se <- 388 aa <- t( as.matrix(x[,c(a.d1.c1,a.d1.c2,a.d1.c3, n.d1.c1,n.d1.c2,n.d1.c3)]) ) ab <- factor( c(rep("th1a",length(a.d1.c1)),rep("th2a",length(a.d1.c2)),rep("th3a",length(a.d1.c3)), rep("th1n",length(n.d1.c1)),rep("th2n",length(n.d1.c2)),rep("th3n",length(n.d1.c3)) ), levels=c("th1a","th2a","th3a","th1n","th2n","th3n") ) ac <- color.groups(c("deepskyblue1","chartreuse1","tan1","blue1","chartreuse4","tan3"), a.d1.c1,a.d1.c2,a.d1.c3, n.d1.c1,n.d1.c2,n.d1.c3) ad <- rep(20,length(ac)) f.tsne(mat=aa, lv=ab, col=ac, psym=ad, pp=3, se.se=se.se, text=F, title=paste("Thalassemia, raw, seed ",se.se,sep=""), lpos="bottomleft") aa <- t( as.matrix(x[,c(a.d2.c1,a.d2.c2, n.d2.c1,n.d2.c2)]) ) ab <- factor( c(rep("an1a",length(a.d2.c1)),rep("an2a",length(a.d2.c2)), rep("an1n",length(n.d2.c1)),rep("an2n",length(n.d2.c2)) ), levels=c("an1a","an2a","an1n","an2n") ) ac <- color.groups(c("deepskyblue1","chartreuse1","blue1","chartreuse4"), a.d2.c1,a.d2.c2, n.d2.c1,n.d2.c2) ad <- rep(20,length(ac)) f.tsne(mat=aa, lv=ab, col=ac, psym=ad, pp=3, se.se=se.se, text=F, title=paste("Aneuploidy, raw, seed ",se.se,sep=""), lpos="bottomleft") aa <- t( as.matrix(x[,c(a.d3.c1,a.d3.c2, n.d3.c1,n.d3.c2)]) ) ab <- factor( c(rep("mo1a",length(a.d3.c1)),rep("mo2a",length(a.d3.c2)), rep("mo1n",length(n.d3.c1)),rep("mo2n",length(n.d3.c2)) ), levels=c("mo1a","mo2a","mo1n","mo2n") ) ac <- color.groups(c("deepskyblue1","chartreuse1","blue1","chartreuse4"), a.d3.c1,a.d3.c2, n.d3.c1,n.d3.c2) ad <- rep(20,length(ac)) f.tsne(mat=aa, lv=ab, col=ac, psym=ad, pp=3, se.se=se.se, text=F, title=paste("Mosaic, raw, seed ",se.se,sep=""), lpos="bottomleft") # mds all aa <- as.matrix(x[,c(a.d1.c1,a.d1.c2,a.d1.c3, o.1, n.d1.c1,n.d1.c2,n.d1.c3)]) ab <- c(rep("th1a",length(a.d1.c1)),rep("th2a",length(a.d1.c2)),rep("th3a",length(a.d1.c3)),rep("other",length(o.1)), rep("th1n",length(n.d1.c1)),rep("th2n",length(n.d1.c2)),rep("th3n",length(n.d1.c3)) ) ac <- color.groups(c("deepskyblue1","chartreuse1","tan1","gray","blue1","chartreuse4","tan3"), a.d1.c1,a.d1.c2,a.d1.c3, o.1, n.d1.c1,n.d1.c2,n.d1.c3) #ad <- rep(20,length(ac)) #mds.eR(expr=aa, coldata=ab, col=ac, pch=ad, main="Thalassemia, raw", p.n=T, norm="none", cex=0.9) ae <- prox.col.wise2(aa, diss.fn="eu.dis") mds.stats(ae, group=ab, colors=ac, pch=20, txt=F, sicol=NULL, coladj=F, main="Thalassemia, raw", kc=0, kccol=c("blue","red"), lpos="topright", roti=0) aa <- as.matrix(x[,c(a.d2.c1,a.d2.c2, o.2, n.d2.c1,n.d2.c2)]) ab <- c(rep("an1a",length(a.d2.c1)),rep("an2a",length(a.d2.c2)),rep("other",length(o.2)), rep("an1n",length(n.d2.c1)),rep("an2n",length(n.d2.c2)) ) ac <- color.groups(c("deepskyblue1","chartreuse1","gray","blue1","chartreuse4"), a.d2.c1,a.d2.c2, o.2, n.d2.c1,n.d2.c2) ae <- prox.col.wise2(aa, diss.fn="eu.dis") mds.stats(ae, group=ab, colors=ac, pch=20, txt=F, sicol=NULL, coladj=F, main="Aneuploidy, raw", kc=0, kccol=c("blue","red"), lpos="topright", roti=0) aa <- as.matrix(x[,c(a.d3.c1,a.d3.c2, o.3, n.d3.c1,n.d3.c2)]) ab <- c(rep("mo1a",length(a.d3.c1)),rep("mo2a",length(a.d3.c2)),rep("other",length(o.3)), rep("mo1n",length(n.d3.c1)),rep("mo2n",length(n.d3.c2)) ) ac <- color.groups(c("deepskyblue1","chartreuse1","gray","blue1","chartreuse4"), a.d3.c1,a.d3.c2, o.3, n.d3.c1,n.d3.c2) ae <- prox.col.wise2(aa, diss.fn="eu.dis") mds.stats(ae, group=ab, colors=ac, pch=20, txt=F, sicol=NULL, coladj=F, main="Mosaic, raw", kc=0, kccol=c("blue","red"), lpos="topright", roti=0) # mds only group samples aa <- as.matrix(x[,c(a.d1.c1,a.d1.c2,a.d1.c3, n.d1.c1,n.d1.c2,n.d1.c3)]) ab <- c(rep("th1a",length(a.d1.c1)),rep("th2a",length(a.d1.c2)),rep("th3a",length(a.d1.c3)), rep("th1n",length(n.d1.c1)),rep("th2n",length(n.d1.c2)),rep("th3n",length(n.d1.c3)) ) ac <- color.groups(c("deepskyblue1","chartreuse1","tan1","blue1","chartreuse4","tan3"), a.d1.c1,a.d1.c2,a.d1.c3, n.d1.c1,n.d1.c2,n.d1.c3) ae <- prox.col.wise2(aa, diss.fn="eu.dis") mds.stats(ae, group=ab, colors=ac, pch=20, txt=F, sicol=NULL, coladj=F, main="Thalassemia, raw", kc=0, kccol=c("blue","red"), lpos="topright", roti=0) aa <- as.matrix(x[,c(a.d2.c1,a.d2.c2, n.d2.c1,n.d2.c2)]) ab <- c(rep("an1a",length(a.d2.c1)),rep("an2a",length(a.d2.c2)), rep("an1n",length(n.d2.c1)),rep("an2n",length(n.d2.c2)) ) ac <- color.groups(c("deepskyblue1","chartreuse1","blue1","chartreuse4"), a.d2.c1,a.d2.c2, n.d2.c1,n.d2.c2) ae <- prox.col.wise2(aa, diss.fn="eu.dis") mds.stats(ae, group=ab, colors=ac, pch=20, txt=F, sicol=NULL, coladj=F, main="Aneuploidy, raw", kc=0, kccol=c("blue","red"), lpos="topright", roti=0) aa <- as.matrix(x[,c(a.d3.c1,a.d3.c2, n.d3.c1,n.d3.c2)]) ab <- c(rep("mo1a",length(a.d3.c1)),rep("mo2a",length(a.d3.c2)), rep("mo1n",length(n.d3.c1)),rep("mo2n",length(n.d3.c2)) ) ac <- color.groups(c("deepskyblue1","chartreuse1","blue1","chartreuse4"), a.d3.c1,a.d3.c2, n.d3.c1,n.d3.c2) ae <- prox.col.wise2(aa, diss.fn="eu.dis") mds.stats(ae, group=ab, colors=ac, pch=20, txt=F, sicol=NULL, coladj=F, main="Mosaic, raw", kc=0, kccol=c("blue","red"), lpos="topright", roti=0) dev.off() return() }