Buck9195/shared_Rscripts
1
0
Fork 0
mirror of https://github.com/dchakro/shared_Rscripts.git synced 2026-05-17 09:12:16 -07:00
Code Issues Projects Releases Packages Wiki Activity Actions

simplified

Browse source
This commit is contained in:
dchakro 2023-08-22 13:46:49 -07:00
parent 949ee59554
commit e344473f7d
1 changed files with 41 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

92
returnPalette.R
View file

@ -1,28 +1,36 @@
returnPalette <- function(ColorVariable = NULL, GNE.colors = F) {
# #<---------------------------->
# # You must include this section when:
# # Distributing, Using and/or Modifying this code.
# # Please read and abide by the terms of the included LICENSE.
# # Copyright 2023, Deepankar Chakroborty, All rights reserved.
# #
# # Author : Deepankar Chakroborty (https://github.com/dchakro)
# # Website: https://www.dchakro.com
# # Report issues: https://github.com/dchakro/shared_Rscripts/issues
# # License: https://github.com/dchakro/shared_Rscripts/blob/master/LICENSE
# #<---------------------------->
# # PURPOSE:
# # Generates an appropriate palette for categorical data based on its length
if (class(ColorVariable) == "character") {
colorsNeeded <- length(unique(ColorVariable))
returnPalette <-
function(ColorVariable = NULL,
GNE.colors = F,
jumble = T) {
# #<---------------------------->
# # You must include this section when:
# # Distributing, Using and/or Modifying this code.
# # Please read and abide by the terms of the included LICENSE.
# # Copyright 2023, Deepankar Chakroborty, All rights reserved.
# #
# # Author : Deepankar Chakroborty (https://github.com/dchakro)
# # Website: https://www.dchakro.com
# # Report issues: https://github.com/dchakro/shared_Rscripts/issues
# # License: https://github.com/dchakro/shared_Rscripts/blob/master/LICENSE
# #<---------------------------->
# # PURPOSE:
# # Generates an appropriate palette for categorical data based on its length
if (class(ColorVariable) == "character") {
colorsNeeded <- length(unique(ColorVariable))
}
if (class(ColorVariable) == "factor") {
colorsNeeded <- length(levels(ColorVariable))
}
if (colorsNeeded < 1) {
myPalette <- c("#DD0000")
warning("Nothing to return color for.")
}
if (colorsNeeded > 1 & colorsNeeded < 10 & GNE.colors == T) {
if (colorsNeeded > 1 &
colorsNeeded < 10 & GNE.colors == T) {
myPalette <-
c(
"#003087",
@ -41,38 +49,20 @@ returnPalette <- function(ColorVariable = NULL, GNE.colors = F) {
palette = "Classic Tableau")
} else if (colorsNeeded >= 10 & colorsNeeded < 18) {
set.seed(2023)
myPalette <- c(palette.colors(n = 10,
palette = "Classic Tableau"),
palette.colors(n = colorsNeeded - 10,
palette = "Set3"))
myPalette <- c(
palette.colors(n = 10,
palette = "Classic Tableau"),
palette.colors(n = colorsNeeded - 10,
palette = "Set3")
)
set.seed(2023)
myPalette <- sample(myPalette)
} else if (colorsNeeded >= 18) {
} else if (colorsNeeded >= 18 & jumble) {
myPalette <- sample(hcl.colors(n = colorsNeeded,
palette = "Spectral"))
} else if (colorsNeeded >= 18 & !jumble) {
myPalette <- hcl.colors(n = colorsNeeded,
palette = "Spectral")
}
}
if (class(ColorVariable) == "factor") {
colorsNeeded <- length(levels(ColorVariable))
if (colorsNeeded < 1) {
myPalette <- c("#DD0000")
warning("Nothing to return color for.")
}
if (colorsNeeded > 1 & colorsNeeded < 10) {
myPalette <- palette.colors(n = colorsNeeded,
palette = "Classic Tableau")
} else if (colorsNeeded >= 10 & colorsNeeded < 18) {
set.seed(2023)
myPalette <- c(palette.colors(n = 10,
palette = "Classic Tableau"),
palette.colors(n = colorsNeeded - 10,
palette = "Set2"))
set.seed(2023)
myPalette <- sample(myPalette)
} else if (colorsNeeded >= 18) {
myPalette <- sample(hcl.colors(n = colorsNeeded,
palette = "Spectral"))
}
}
return(myPalette)
}
return(myPalette)
}