#GeneSurvey Copyright 2014, 2015, 2016 University of Texas MD Anderson Cancer Center
#
#This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 2 of the License, or (at your option) any later version.
#
#This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
#You should have received a copy of the GNU General Public License along with this program. If not, see <http://www.gnu.org/licenses/>.
# Onnes' color distance algorithm as shown in Java by Danny6 Plughoeft
# (which I converted to R) from http://stackoverflow.com/questions/2103368/color-logic-algorithm
# to select as distinct as possible colors.
colorDistance <- function(theColor1, theColor2)
{
rgb1 <- col2rgb(theColor1)[,1]
rgb2 <- col2rgb(theColor2)[,1]
rmean <- (rgb1[["red"]] + rgb2[["red"]]) / 2;
r <- rgb1[["red"]] - rgb2[["red"]];
g <- rgb1[["green"]] - rgb2[["green"]];
b <- rgb1[["blue"]] - rgb2[["blue"]];
weightR <- 2 + (rmean/256)
weightG <- 4.0;
weightB <- 2 + (255-rmean)/256;
sqrt((weightR*r*r) + (weightG*g*g) + (weightB*b*b))
}
getColorsDistance <- function(theColor, thePossibleColors)
{
sapply(thePossibleColors, colorDistance, theColor)
}
colorDistEval <- function(theValues)
{
min(theValues)
}
mycolors <- function()
{
setdiff(colors(), c("white", "black", "floralwhite", "ghostwhite",
"gray0", "gray1", "gray2", "gray3", "gray4", "gray5", "gray6", "gray7", "gray8", "gray9",
"gray10", "gray11", "gray12", "gray13", "gray14", "gray15", "gray16", "gray17", "gray18",
"gray19", "gray20", "gray21", "gray22", "gray23", "gray24", "gray25",
"gray95", "gray96", "gray97", "gray98", "gray99", "gray100",
"grey0", "grey1", "grey2", "grey3", "grey4", "grey5", "grey6", "grey7", "grey8", "grey9",
"grey10", "grey11", "grey12", "grey13", "grey14", "grey15", "grey16", "grey17", "grey18",
"grey19", "grey20", "grey21", "grey22", "grey23", "grey24", "grey25",
"grey95", "grey96", "grey97", "grey98", "grey99", "grey100",
"ivory", "ivory1", "oldlace", "snow", "snow1", "whitesmoke",
"lightyellow", "lightyellow1", "mintcream", "honeydew", "honeydew1",
"azure", "azure1", "lightcyan", "lightcyan1", "cornsilk", "cornsilk1",
"thistle1", "lemonchiffon", "lemonchiffon1", "lightgoldenrodyellow",
"chartreuse", "springgreen2", "seashell", "paleturquoise1", "grey", "gray", "gold",
"pink", "burlywood2"
))
}
getColorList <- function(theCount, theUsedColors=c("green"))
{
colorList <- theUsedColors
while(length(colorList)<theCount)
{
possibleColors <- setdiff(mycolors(), colorList)
distances <- sapply(colorList, getColorsDistance, possibleColors)
nextColor <- ""
greatestValue <- 0
for(newcolor in rownames(distances))
{
mymean <- colorDistEval(distances[newcolor,])
if (mymean>greatestValue)
{
greatestValue <- mymean
nextColor <- newcolor
}
}
colorList <- c(colorList, nextColor)
}
colorList
}
testColors <- function()
{
knownDiseases <- c("ACC", "BLCA", "BRCA", "CESC", "CHOL", "COAD",
"DLBC", "ESCA", "GBM", "HNSC", "KICH", "KIRC", "KIRP",
"LAML", "LGG", "LIHC", "LUAD", "LUSC", "MESO", "OV",
"PAAD", "PCPG", "PRAD", "READ", "SARC", "SKCM", "STAD",
"TGCT", "THCA", "UCEC", "UCS", "UVM", "FPPP", "THYM")
# knownDiseases <- c("ACC", "BLCA", "BRCA", "CESC", "CHOL", "CNTL", "COAD",
# "DLBC", "ESCA", "GBM", "HNSC", "KICH", "KIRC", "KIRP",
# "LAML", "LGG", "LIHC", "LUAD", "LUSC", "MESO", "OV",
# "PAAD", "PCPG", "PRAD", "READ", "SARC", "SKCM", "STAD",
# "TGCT", "THCA", "UCEC", "UCS", "UVM", "FPPP", "THYM")
tcgaColors <- getColorsForDiseases(knownDiseases)
x <- 20*(1:length(tcgaColors))
y <- 20*(1:length(tcgaColors))
pie(rep(1,length(tcgaColors)), col = tcgaColors, labels=knownDiseases, radius=1)
}
getColorsForDiseases <- function(theDiseaseList)
{
# for SARC - replaced bisque with burlywood2
# for TGCT - replaced khaki with darkkhaki
# for ESCA - replaced lightgray with slategray
# for KICH - replaced cadetblue1 with cadetblue3
knownDiseases <- c("ACC", "BLCA", "BRCA", "CESC", "CHOL", "CNTL", "COAD",
"DLBC", "ESCA", "GBM", "HNSC", "KICH", "KIRC", "KIRP",
"LAML", "LGG", "LIHC", "LUAD", "LUSC", "MESO", "OV",
"PAAD", "PCPG", "PRAD", "READ", "SARC", "SKCM", "STAD",
"TGCT", "THCA", "UCEC", "UCS", "UVM", "FPPP", "THYM")
knownColors <- c( "darkcyan", "green", "blue", "purple", "firebrick", "midnightblue", "brown",
"red", "slategray", "darkgreen", "magenta", "cadetblue3", "goldenrod", "violet",
"grey", "olivedrab", "cyan", "gold", "turquoise", "chocolate", "pink",
"dodgerblue", "mediumvioletred", "forestgreen", "brown1", "burlywood2", "darkgray", "orange",
"darkkhaki", "seagreen", "tomato", "sienna", "darkorchid", "chartreuse1", "springgreen")
returnColors <- knownColors
names(returnColors) <- knownDiseases
returnColors <- returnColors[which(names(returnColors) %in% theDiseaseList)]
newDiseases <- setdiff(theDiseaseList, knownDiseases)
if (length(newDiseases)>0)
{
newColors <- getColorList((length(knownColors)+length(newDiseases)), knownColors)[(1+length(knownColors)):(length(knownColors)+length(newDiseases))]
newColorSet <- c(returnColors, newColors)
names(newColorSet) <- c(names(returnColors), newDiseases)
returnColors <- newColorSet
}
returnColors <- returnColors[order(names(returnColors))]
returnColors
}
getColorListAny <- function(theCount, theUsedColors=c("green"))
{
colorList <- theUsedColors
while(length(colorList)<theCount)
{
possibleColors <- setdiff(mycolors(), colorList)
distances <- sapply(colorList, getColorsDistance, possibleColors)
nextColor <- ""
greatestValue <- 0
for(newcolor in rownames(distances))
{
mymean <- colorDistEval(distances[newcolor,])
if (mymean>greatestValue)
{
greatestValue <- mymean
nextColor <- newcolor
}
}
colorList <- c(colorList, nextColor)
}
colorList
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.