Ternary plot feature mapping

[seokjune-99]

Hello, i have big interests of your Mesomics project, so i just try to do similar analyses with other cancer datasets.
However i keep struggling to do mapping the feature to ternary plot like below.
(I tried [ColourTernary] function with package 'Ternary' and [stat_density_tern] function with package 'ggtern', but none of it goes well)
Can u share me the codes or some tips to doing that one?
Thanks :)

[lisemangiante]

Hello, thank you for your interest in our work!
Please, find below a simplified script that reproduces those figures using the Source Data Figure 2 from the manuscript.

require(dplyr)
require(Ternary)
library(openxlsx)
library(dichromat)
require(cowplot)

data_path = "path/to/saved/source/data/figure/2/"

## Load data
source_data_fig2_tern = read.xlsx(paste0(data_path,"41588_2023_1321_MOESM6_ESM.xlsx"), sheet = 2)
source_data_fig2_quantiseq = read.xlsx(paste0(data_path,"41588_2023_1321_MOESM6_ESM.xlsx"), sheet = 3, startRow = 2)
source_data_fig2_mki67 = read.xlsx(paste0(data_path,"41588_2023_1321_MOESM6_ESM.xlsx"), sheet = 4)

## Prepare data
source_data_fig2_quantiseq = source_data_fig2_quantiseq[1:120,]
rownames(source_data_fig2_quantiseq) = source_data_fig2_quantiseq$Sample
source_data_fig2_quantiseq = source_data_fig2_quantiseq[which(!is.na(source_data_fig2_quantiseq$Total.Immune.cells.quanTIseq)),]
source_data_fig2_quantiseq$Total.Immune.cells.quanTIseq = as.numeric(source_data_fig2_quantiseq$Total.Immune.cells.quanTIseq)

source_data_fig2_tern = source_data_fig2_tern[,-1]
source_data_fig2_tern = source_data_fig2_tern[which(source_data_fig2_tern$Cohort == "MESOMICS"),]
rownames(source_data_fig2_tern) = source_data_fig2_tern$ID
source_data_fig2_tern$MOFA.MESOMICS.Cell.division = as.numeric(source_data_fig2_tern$MOFA.MESOMICS.Cell.division)
source_data_fig2_tern$`MOFA.MESOMICS.Tumor-immune-interaction` = as.numeric(source_data_fig2_tern$`MOFA.MESOMICS.Tumor-immune-interaction`)
source_data_fig2_tern$MOFA.MESOMICS.Acinar = as.numeric(source_data_fig2_tern$MOFA.MESOMICS.Acinar)
colnames(source_data_fig2_tern)[1] = "ID_IARC"

source_data_fig2_mki67 = source_data_fig2_mki67[which(source_data_fig2_mki67$Cohort == "MESOMICS"),]
rownames(source_data_fig2_mki67) = source_data_fig2_mki67$Sample
source_data_fig2_mki67$MKI67.expression = as.numeric(source_data_fig2_mki67$MKI67.expression)

MKI67 = data.frame(ID_IARC = rownames(source_data_fig2_tern),
                   MKI67 = sapply(rownames(source_data_fig2_tern), function(x) if(x %in% rownames(source_data_fig2_mki67)){source_data_fig2_mki67$MKI67.expression[which(rownames(source_data_fig2_mki67) == x)]}else{NA} ))
inf = data.frame(ID_IARC = rownames(source_data_fig2_tern),
                 inf = sapply(rownames(source_data_fig2_tern), function(x) if(x %in% rownames(source_data_fig2_quantiseq)){source_data_fig2_quantiseq$Total.Immune.cells.quanTIseq[which(rownames(source_data_fig2_quantiseq) == x)]}else{NA}))

ARCs_cov = left_join(x= left_join(x=source_data_fig2_tern[,c(1,3:5)], y=MKI67, by=c("ID_IARC")), y=inf, by=c("ID_IARC"))
colnames(ARCs_cov)[2:4] = c("Arc1","Arc2","Arc3")

coord.V = rbind(c(-0.5,0),c(0,0.86),c(0.5,0))
ARCs_cov.simplexcoord = t( sapply(1:nrow(ARCs_cov), function(i) ARCs_cov[i,]$Arc1*coord.V[1,] + 
                                    ARCs_cov[i,]$Arc2*coord.V[2,] + ARCs_cov[i,]$Arc3*coord.V[3,]  ) )

denshighhypo = TernaryDensity(ARCs_cov %>% dplyr::select(Arc2,Arc3,Arc1),
                              resolution = 48L, direction = getOption("ternDirection",1L)) # just used to get coordinates

denshigh.cols = data.frame(MKI67 = rep(NA,ncol(denshighhypo)), inf = NA)
for(i in 1:ncol(denshighhypo)){
  wtmp = exp( -((ARCs_cov.simplexcoord[,1]- as.numeric(denshighhypo[1,i]) )**2+(ARCs_cov.simplexcoord[,2]- as.numeric(denshighhypo[2,i]))**2)/2/0.1**2 ) # compute gaussian kernel
  denshigh.cols$MKI67[i] = sum(wtmp*ARCs_cov$MKI67,na.rm=T)/sum(wtmp)
  denshigh.cols$inf[i] = sum(wtmp*ARCs_cov$inf,na.rm=T)/sum(wtmp)
}

colfunc.bg = colorRampPalette(c("#880e24ff", "white", "#22746fff")) #red - blue/green
denshigh.cols$MKI67.col = rev(colfunc.bg(21))[round( (denshigh.cols$MKI67-min(denshigh.cols$MKI67))/(max(denshigh.cols$MKI67)-min(denshigh.cols$MKI67))*20 )+1]

colfunc.rg = colorRampPalette(c("#365060ff", "white", "#89610dff"))
denshigh.cols$inf.col = rev(colfunc.rg(21))[round( (denshigh.cols$inf-min(denshigh.cols$inf))/(max(denshigh.cols$inf)-min(denshigh.cols$inf))*20 )+1]

## Ternary plots
## Arc-1: MKI67
denshighhypo[3,] = denshigh.cols$MKI67.col

TernaryPlot(point = "up", 
            lab.cex = 0.8, grid.minor.lines = 0,
            grid.lines = 5,
            lab.offset = 0.18,
            grid.lty = 'solid', col = rgb(0.9, 0.9, 0.9), grid.col = 'white', 
            axis.col = rgb(0.6, 0.6, 0.6), ticks.col = rgb(0.6, 0.6, 0.6),
            axis.rotate = FALSE,
            padding = 0.12)
ColourTernary(denshighhypo, spectrum = NULL,direction = 1)
TernaryLines(list(c(0, 255, 0), rep(50,3)), col = 'grey')
TernaryLines(list(c(0, 0, 255), rep(50,3)), col = 'grey')
TernaryLines(list(c(255, 0, 0), rep(50,3)), col = 'grey')
AddToTernary(text, c(50,50,50), "Proliferation (MKI67)", cex = 0.8, font = 2, col = 'black')
dev.off()

l1 = get_legend(ggplot(denshigh.cols, aes(x = MKI67, y = 1, fill = MKI67)) + geom_tile(aes(fill = MKI67), colour = "grey") + 
                  scale_fill_gradient2(low = "#22746fff", mid = "white", high = "#880e24ff", midpoint = mean(denshigh.cols$MKI67[which(denshigh.cols$MKI67.col == "#FFFFFF")]), name = "MKI67 (nrc)"))
plot_grid(l1)

## Arc-2: Infiltration
denshighhypo[3,] = denshigh.cols$inf.col

TernaryPlot(point = "up", 
            lab.cex = 0.8, grid.minor.lines = 0,
            grid.lines = 5,
            lab.offset = 0.18,
            grid.lty = 'solid', col = rgb(0.9, 0.9, 0.9), grid.col = 'white', 
            axis.col = rgb(0.6, 0.6, 0.6), ticks.col = rgb(0.6, 0.6, 0.6),
            axis.rotate = FALSE,
            padding = 0.12)
ColourTernary(denshighhypo, spectrum = NULL,direction = 1)
TernaryLines(list(c(0, 255, 0), rep(50,3)), col = 'grey')
TernaryLines(list(c(0, 0, 255), rep(50,3)), col = 'grey')
TernaryLines(list(c(255, 0, 0), rep(50,3)), col = 'grey')
AddToTernary(text, c(50,50,50), "Immune infiltration", cex = 0.8, font = 2, col = 'black')
dev.off()

l1 = get_legend(ggplot(denshigh.cols, aes(x = inf*100, y = 1, fill = inf*100)) + geom_tile(aes(fill = inf*100), colour = "grey") + 
                  scale_fill_gradient2(low = "#89610dff", mid = "white", high = "#365060ff", midpoint = mean(denshigh.cols$inf[which(denshigh.cols$inf.col == "#FFFFFF")])*100, name = "Infiltration (%)"))
plot_grid(l1)