Skip to content

Commit ebea59e

Browse files
authored
Allow custom color palettes for XString objects (#123)
Add functions update_DNA_palette(), update_RNA_palette(), update_AA_palette(), and update_B_palette(), to let users set their own color palettes for XString/XStringSet objects.
1 parent 1169409 commit ebea59e

File tree

6 files changed

+309
-54
lines changed

6 files changed

+309
-54
lines changed

NAMESPACE

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,10 @@ export(
7070
BStringSetList, DNAStringSetList, RNAStringSetList, AAStringSetList,
7171

7272
## xscat.R:
73-
xscat
73+
xscat,
74+
75+
## coloring.R:
76+
update_DNA_palette, update_RNA_palette, update_AA_palette, update_B_palette
7477
)
7578

7679
exportMethods(

R/coloring.R

Lines changed: 72 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,6 @@
11
### =========================================================================
2-
### add_colors()
2+
### XString Display Colors
33
### -------------------------------------------------------------------------
4-
###
5-
### Nothing in this file is exported.
6-
###
7-
8-
### Placeholder, initialized in .onLoad()
9-
DNA_AND_RNA_COLORED_LETTERS <- NULL
10-
AA_COLORED_LETTERS <- NULL
114

125
### Return a named character vector where all the names are single letters.
136
### Colors for A, C, G, and T were inspired by
@@ -36,28 +29,6 @@ make_DNA_AND_RNA_COLORED_LETTERS <- function()
3629
)
3730
}
3831

39-
### 'x' must be a character vector.
40-
.add_dna_and_rna_colors <- function(x)
41-
{
42-
if (!isTRUE(getOption("Biostrings.coloring", default=FALSE)))
43-
return(x)
44-
ans <- vapply(x,
45-
function(xi) {
46-
xi <- safeExplode(xi)
47-
m <- match(xi, names(DNA_AND_RNA_COLORED_LETTERS))
48-
match_idx <- which(!is.na(m))
49-
xi[match_idx] <- DNA_AND_RNA_COLORED_LETTERS[m[match_idx]]
50-
paste0(xi, collapse="")
51-
},
52-
character(1),
53-
USE.NAMES=FALSE
54-
)
55-
x_names <- names(x)
56-
if (!is.null(x_names))
57-
names(ans) <- x_names
58-
ans
59-
}
60-
6132
### Return a named character vector where all the names are single letters.
6233
### Colors amino acids by similarity
6334
### Colors groupins by
@@ -118,16 +89,18 @@ make_AA_COLORED_LETTERS <- function(){
11889
}
11990

12091
### 'x' must be a character vector.
121-
.add_aa_colors <- function(x)
92+
## env_var_name is the name of the corresponding palette in .pkgenv
93+
.add_xstring_colors <- function(x, env_var_name)
12294
{
12395
if (!isTRUE(getOption("Biostrings.coloring", default=FALSE)))
12496
return(x)
97+
color_palette <- get(env_var_name, envir=.pkgenv)
12598
ans <- vapply(x,
12699
function(xi) {
127100
xi <- safeExplode(xi)
128-
m <- match(xi, names(AA_COLORED_LETTERS))
101+
m <- match(xi, names(color_palette))
129102
match_idx <- which(!is.na(m))
130-
xi[match_idx] <- AA_COLORED_LETTERS[m[match_idx]]
103+
xi[match_idx] <- color_palette[m[match_idx]]
131104
paste0(xi, collapse="")
132105
},
133106
character(1),
@@ -139,7 +112,71 @@ make_AA_COLORED_LETTERS <- function(){
139112
ans
140113
}
141114

115+
.update_X_palette <- function(colors=NULL, env_var_name,
116+
alphabet, default_palette_function){
117+
## passing default_palette_function as a function pointer so we don't
118+
## have to evaluate it unless necessary
119+
palette <- get(env_var_name, envir=.pkgenv)
120+
if(is.null(colors))
121+
palette <- default_palette_function()
122+
if(!is.null(colors)){
123+
if(!is.list(colors)){
124+
stop("'colors' should be NULL or a named list of entries with 'bg' ",
125+
"and optionally 'fg' values.")
126+
}
127+
128+
n <- names(colors)
129+
if(!is.null(alphabet) && length(setdiff(n, alphabet)) != 0){
130+
## non-BStrings: checking if the characters are valid
131+
stop("Invalid codes specified.")
132+
} else if(is.null(alphabet)){
133+
## BStrings: checking for single characters (0:255 in raw)
134+
name_nchars <- vapply(n, \(x) length(charToRaw(x)), integer(1L))
135+
if(!all(name_nchars == 1L))
136+
stop("Invalid codes specified.")
137+
}
138+
139+
for(i in seq_along(colors)){
140+
fg <- colors[[i]]$fg
141+
bg <- colors[[i]]$bg
142+
if(is.null(fg) && is.null(bg)){
143+
palette[n[i]] <- n[i]
144+
} else if(is.null(bg)) {
145+
palette[n[i]] <- make_style(fg)(n[i])
146+
} else {
147+
if(is.null(fg)) fg <- rgb(1,1,1)
148+
palette[n[i]] <- make_style(bg, bg=TRUE)(make_style(fg)(n[i]))
149+
}
150+
}
151+
}
152+
153+
assign(env_var_name, palette, envir=.pkgenv)
154+
}
155+
156+
update_DNA_palette <- function(colors=NULL){
157+
.update_X_palette(colors, "DNA_AND_RNA_COLORED_LETTERS",
158+
union(DNA_ALPHABET, RNA_ALPHABET),
159+
make_DNA_AND_RNA_COLORED_LETTERS)
160+
}
161+
162+
update_RNA_palette <- update_DNA_palette
163+
164+
update_AA_palette <- function(colors=NULL){
165+
.update_X_palette(colors, "AA_COLORED_LETTERS",
166+
AA_ALPHABET,
167+
make_AA_COLORED_LETTERS)
168+
}
169+
170+
update_B_palette <- function(colors=NULL){
171+
## BStrings don't have a default palette
172+
## thus their default palette function is just \() return(character(0L))
173+
.update_X_palette(colors, "B_COLORED_LETTERS",
174+
NULL,
175+
\(){ character(0L) })
176+
}
177+
142178
add_colors <- function(x) UseMethod("add_colors")
143179
add_colors.default <- identity
144-
add_colors.DNA <- add_colors.RNA <- .add_dna_and_rna_colors
145-
add_colors.AA <- .add_aa_colors
180+
add_colors.DNA <- add_colors.RNA <- function(x){ .add_xstring_colors(x, "DNA_AND_RNA_COLORED_LETTERS") }
181+
add_colors.AA <- function(x){ .add_xstring_colors(x, "AA_COLORED_LETTERS") }
182+
add_colors.B <- function(x) { .add_xstring_colors(x, "B_COLORED_LETTERS") }

R/zzz.R

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
###
22

3+
.pkgenv <- new.env(parent=emptyenv())
4+
35
.onLoad <- function(libname, pkgname)
46
{
57
.Call2("init_DNAlkups",
@@ -11,8 +13,11 @@
1113
.Call2("init_AAlkups",
1214
AA_STRING_CODEC@enc_lkup, AA_STRING_CODEC@dec_lkup,
1315
PACKAGE=pkgname)
14-
DNA_AND_RNA_COLORED_LETTERS <<- make_DNA_AND_RNA_COLORED_LETTERS()
15-
AA_COLORED_LETTERS <<- make_AA_COLORED_LETTERS()
16+
17+
assign("DNA_AND_RNA_COLORED_LETTERS", make_DNA_AND_RNA_COLORED_LETTERS(), envir=.pkgenv)
18+
assign("AA_COLORED_LETTERS", make_AA_COLORED_LETTERS(), envir=.pkgenv)
19+
assign("B_COLORED_LETTERS", character(0L), envir=.pkgenv)
20+
1621
option_name <- "Biostrings.coloring"
1722
if (!(option_name %in% names(.Options)))
1823
options(setNames(list(TRUE), option_name))

man/coloring.Rd

Lines changed: 119 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,119 @@
1+
\name{coloring}
2+
3+
\alias{coloring}
4+
\alias{update_X_palette}
5+
\alias{update_DNA_palette}
6+
\alias{update_RNA_palette}
7+
\alias{update_AA_palette}
8+
\alias{update_B_palette}
9+
10+
\title{XString Display Colors}
11+
12+
\description{
13+
\link{XString} objects support custom coloring for display. Users can also set custom color palettes for XString objects using the \code{update_X_palette} functions.
14+
}
15+
16+
\usage{
17+
update_DNA_palette(colors=NULL)
18+
update_RNA_palette(colors=NULL)
19+
update_AA_palette(colors=NULL)
20+
update_B_palette(colors=NULL)
21+
}
22+
23+
\arguments{
24+
\item{colors}{
25+
A named list of colors to update, with entries \code{fg} and \code{bg} specifying the foreground and background colors, respectively. Colors can be specified in any way compatible with \code{\link[crayon]{make_style}} from the \code{crayon} package. Defaults to \code{NULL}, which resets the color palette to the default color scheme. See Details and Examples for more information.
26+
}
27+
}
28+
29+
\details{
30+
\link{XString} objects support the following default coloring for display.
31+
\itemize{
32+
\item DNAString: A, C, G, and T are colored red, green, blue, and orange (respectively), N is colored light grey, other ambiguity codes are colored dark grey, and \code{"-+."} have no coloring.
33+
\item RNAString: All bases are colored identically to DNAString. U is colored yellow.
34+
\item AAString: Amino acids are colored according to JalView's Zappo color scheme, representing physicochemical properties. X is colored light grey, other ambiguity codes are colored dark grey, and \code{"*-+."} are not colored.
35+
\item BStrings are not colored.
36+
}
37+
38+
Users can change the default color scheme of Biostrings with the \code{update_X_palette} family functions. Each function expects a \code{list} with named entries corresponding to the values to update. Each entry can specify \code{'fg'} and \code{'bg'} values, corresponding to the foreground and background colors (respectively). If \code{'fg'} is not specified, it defaults to \code{rgb(1,1,1)} (white). If \code{'bg'} is not specified, it defaults to transparent.
39+
40+
These functions will only update the values passed, leaving the rest of the colors as-is. For example, calling \code{update_AA_palette(list(A=list(fg="green")))} would update the coloring for \code{A} while leaving all other colors as the default schema.
41+
42+
To reset all colors to the default palette, call the function with no arguments (\code{NULL}).
43+
44+
To remove a coloring for a specific value, provide a named entry with value \code{NULL}. For example, \code{update_AA_palette(list(A=NULL))} will remove the coloring for \code{A}.
45+
46+
\code{update_DNA_palette} and \code{update_RNA_palette} are identical internally, so either function can be used to update colorings for \code{T,U}.
47+
48+
See the Examples section for more examples of custom colorings.
49+
}
50+
51+
\value{
52+
For \code{update_X_palette}, Invisibly returns the new color mapping, consisting of a named character vector. Calling \code{cat} on the return value will print out all letters with their respective coloring.
53+
}
54+
55+
\author{Aidan Lakshman <AHL27@pitt.edu>}
56+
57+
\seealso{
58+
\link{XString-class}
59+
}
60+
61+
\examples{
62+
## display default colors
63+
DNAString(paste(DNA_ALPHABET, collapse=''))
64+
RNAString(paste(RNA_ALPHABET, collapse=''))
65+
AAString(paste(AA_ALPHABET, collapse=''))
66+
BString(paste(LETTERS, collapse=''))
67+
68+
## create new palettes
69+
DNA_palette <- list(
70+
A=list(fg="blue",bg="black"),
71+
T=list(fg="red",bg='black'),
72+
G=list(fg='green',bg='black'),
73+
C=list(fg='yellow',bg='black')
74+
)
75+
update_DNA_palette(DNA_palette)
76+
DNAString(paste(DNA_ALPHABET, collapse=''))
77+
78+
## reset to default palette
79+
update_DNA_palette()
80+
DNAString(paste(DNA_ALPHABET, collapse=''))
81+
82+
## colors can also be specified with `rgb()`
83+
AA_palette <- list(
84+
A=list(fg="white", bg="purple"),
85+
B=list(fg=rgb(1,1,1), bg='orange')
86+
)
87+
update_AA_palette(AA_palette)
88+
AAString(paste(AA_ALPHABET, collapse=''))
89+
90+
## remove all coloring for QEG
91+
update_AA_palette(list(Q=NULL, E=NULL, G=NULL))
92+
AAString(paste(AA_ALPHABET, collapse=''))
93+
94+
## reset to default
95+
update_AA_palette()
96+
AAString(paste(AA_ALPHABET, collapse=''))
97+
98+
## We can also add colors to BStrings,
99+
## which are normally not colored
100+
101+
## if 'fg' is not specified, defaults to rgb(1,1,1)
102+
## if 'bg' is not specified, background is transparent
103+
B_palette <- list(
104+
A=list(bg='green'),
105+
B=list(bg="red"),
106+
C=list(bg='blue'),
107+
D=list(fg="orange"),
108+
E=list(fg="yellow")
109+
)
110+
update_B_palette(B_palette)
111+
BString(paste(LETTERS, collapse=''))
112+
113+
## can also directly view the changes with cat
114+
cat(update_B_palette(B_palette), '\n')
115+
116+
## reset to default
117+
update_B_palette()
118+
BString(paste(LETTERS, collapse=''))
119+
}

0 commit comments

Comments
 (0)