## wrapping tokens in span attributes
#' add span tags to tokens
#'
#' This is the main function for adding colors, onclick effects, etc. to tokens, for which <span> tags are used. The named arguments are used to set the attributes.
#'
#' If a token does not have any attributes, the <span> tag is not added.
#'
#' Note that the attr_style() function can be used to conveniently set the style attribute. Also, the set_col(), highlight_col() and scale_col() functions can be used to set the color of style attributes. See the example for illustration.
#'
#' @param tokens a vector of tokens.
#' @param tag The name of the tag to be used
#' @param span_adjacent If TRUE, include adjacent tokens with identical attributes within the same tag
#' @param doc_id If span_adjacent is TRUE, The document ids are required to ensure that tags do not span from one document to another.
#' @param unfold Either a character vector or a named list of vectors of the same length as tokens. If given, all tokens with a tag can be clicked on to unfold the given text. If a list of vectors is given,
#' the values of the columns are concatenated with the column name. E.g. list(doc_id = 1, sentence = 1) will be [doc_id = 1, sentence = 2].
#' This only works if the tagged tokens are used in the html browser created with the \code{\link{create_browser}} function (as it relies on javascript).
#' @param ... named arguments are used as attributes in the span tag for each token, with the name being the name
#' of the attribute (e.g., class, . Each argument must be a vector of the same length as the number of tokens.
#' NA values can be used to ignore attribute for a token, and if a token has NA for each attribute,
#' it is not given a span tag.
#'
#' @return a character vector of tagged tokens
#' @export
#'
#' @examples
#' tag_tokens(tokens = c('token_1','token_2', 'token_3'),
#' class = c(1,1,2),
#' style = attr_style(color = set_col('red'),
#' `background-color` = highlight_col(c(FALSE,FALSE,TRUE))))
#'
#' ## tokens without attributes are not given a span tag
#' tag_tokens(tokens = c('token_1','token_2', 'token_3'),
#' class = c(1,NA,NA),
#' style = attr_style(color = highlight_col(c(TRUE,TRUE,FALSE))))
#'
#' ## span_adjacent can be used to put tokens with identical tags within one tag
#' ## but then a doc_id has to be given as well
#' tag_tokens(tokens = c('token_1','token_2', 'token_3'),
#' class = c(1,1,NA),
#' span_adjacent=TRUE,
#' doc_id = c(1,1,1))
tag_tokens <- function(tokens, tag='span', span_adjacent=F, doc_id=NULL, unfold=NULL, ...) {
attr_str = tag_attr(...)
if (is.null(attr_str)) return(tokens)
if (length(attr_str) == 1) attr_str = rep(attr_str, length(tokens))
has_attr = attr_str != ''
tokens = ifelse(!has_attr,
yes = as.character(tokens), ## if a token has no attributes, do not add a span tag.
no = add_tag(as.character(tokens), tag, attr_str, span_adjacent = span_adjacent, doc_id=doc_id))
if (!is.null(unfold)) {
n = length(tokens)
if (methods::is(unfold, 'data.frame') | methods::is(unfold,'list')) {
for (j in seq_along(unfold)) {
v = unfold[[j]]
if (methods::is(v, 'factor') | methods::is(v, 'character')) v = paste0('"', v, '"')
if (length(v) != n) stop(sprintf('The vector %s in unfold is not of the same length as the number of tokens', names(unfold)[j]))
if (j == 1) unfold_string = paste(names(unfold)[j], v[has_attr], sep=' = ')
if (j > 1) unfold_string = paste(unfold_string, paste(names(unfold)[j], v[has_attr], sep=' = '), sep=', ')
}
} else {
if (length(unfold) != n) stop('the unfold vector is not of the same length as the number of tokens')
unfold_string = unfold[has_attr]
}
tokens[has_attr] = sprintf('<unfoldspan>%s</unfoldspan><font style="display:none;" color="blue"> [%s]</font>', tokens[has_attr], unfold_string)
}
tokens
}
#' Highlight tokens
#'
#' This is a convenience wrapper for tag_tokens() that can be used if tokens only need to be colored.
#'
#' @param tokens A character vector of tokens
#' @param value Either a logical vector or a numeric vector with values between 0 and 1.
#' If a logical vector is used, then tokens with TRUE will be highlighted (with the color specified in pos_col).
#' If a numeric vector is used, the value determines the alpha (transparency), with 0 being fully transparent
#' and 1 being fully colored.
#' @param class Optionally, a character vector of the class to add to the span tags. If NA no class is added
#' @param col The color used to highlight
#' @param unfold Either a character vector or a named list of vectors of the same length as tokens. If given, all tokens with a tag can be clicked on to unfold the given text. If a list of vectors is given,
#' the values of the columns are concatenated with the column name. E.g. list(doc_id = 1, sentence = 1) will be [doc_id = 1, sentence = 2].
#' This only works if the tagged tokens are used in the html browser created with the \code{\link{create_browser}} function (as it relies on javascript).
#' @param span_adjacent If TRUE, include adjacent tokens with identical attributes within the same tag
#' @param doc_id If span_adjacent is TRUE, The document ids are required to ensure that tags do not span from one document to another.
#'
#'
#' @return a character vector of color-tagged tokens
#' @export
#'
#' @examples
#' highlight_tokens(c('token_1','token_2','token_3'),
#' value = c(FALSE,FALSE,TRUE))
#'
#' highlight_tokens(c('token_1','token_2','token_3'),
#' value = c(0,0.3,0.6))
highlight_tokens <- function(tokens, value, class=NULL, col='yellow', unfold=NULL, span_adjacent=F, doc_id=NULL) {
tokens = gsub('[<>]', '', tokens)
col = highlight_col(value, col=col)
tokens = tag_tokens(tokens,
class=class,
style = attr_style(`background-color` = col),
unfold = unfold,
span_adjacent=span_adjacent, doc_id=doc_id)
tokens
}
#' Color tokens using colorRamp
#'
#' This is a convenience wrapper for tag_tokens() that can be used if tokens only need to be colored.
#'
#' @param tokens A character vector of tokens
#' @param value A numeric vector with values between -1 and 1. Determines the color mixture of the scale colors
#' specified in col_range
#' @param alpha Optionally, the alpha (transparency) can be specified, with 0 being fully transparent and 1 being
#' fully colored. This can be a vector to specify a different alpha for each value.
#' @param class Optionally, a character vector of the class to add to the span tags. If NA no class is added
#' @param col_range The colors used in the scale ramp.
#' @param unfold Either a character vector or a named list of vectors of the same length as tokens. If given, all tokens with a tag can be clicked on to unfold the given text. If a list of vectors is given,
#' the values of the columns are concatenated with the column name. E.g. list(doc_id = 1, sentence = 1) will be [doc_id = 1, sentence = 2].
#' This only works if the tagged tokens are used in the html browser created with the \code{\link{create_browser}} function (as it relies on javascript).
#' @param span_adjacent If TRUE, include adjacent tokens with identical attributes within the same tag
#' @param doc_id If span_adjacent is TRUE, The document ids are required to ensure that tags do not span from one document to another.
#'
#' @return a character vector of color-tagged tokens
#' @export
#'
#' @examples
#' colorscale_tokens(c('token_1','token_2','token_3'),
#' value = c(-1,0,1))
colorscale_tokens <- function(tokens, value, alpha=0.4, class=NULL, col_range=c('red', 'blue'), unfold=NULL, span_adjacent=F, doc_id=NULL) {
tokens = gsub('[<>]', '', tokens)
col = scale_col(value, alpha=alpha, col_range=col_range)
tag_tokens(tokens,
class=class,
style = attr_style(`background-color` = col),
unfold=unfold,
span_adjacent=span_adjacent, doc_id=doc_id)
}
#' Highlight tokens per category
#'
#' This is a convenience wrapper for tag_tokens() that can be used if tokens need to be colored per category
#'
#' @param tokens A character vector of tokens
#' @param category Either a factor, or a numeric vector with values representing category indices. If a numeric vector is used, labels must also be given
#' @param labels A character vector with labels for the categories
#' @param alpha Optionally, the alpha (transparency) can be specified, with 0 being fully transparent and 1 being
#' fully colored. This can be a vector to specify a different alpha for each value.
#' @param class Optionally, a character vector of the class to add to the span tags. If NA no class is added
#' @param colors A character vector with color names for unique values of the value argument. Has to be the same length
#' as unique(na.omit(category))
#' @param unfold Either a character vector or a named list of vectors of the same length as tokens. If given, all tokens with a tag can be clicked on to unfold the given text. If a list of vectors is given,
#' the values of the columns are concatenated with the column name. E.g. list(doc_id = 1, sentence = 1) will be [doc_id = 1, sentence = 2].
#' This only works if the tagged tokens are used in the html browser created with the \code{\link{create_browser}} function (as it relies on javascript).
#' @param span_adjacent If TRUE, include adjacent tokens with identical attributes within the same tag
#' @param doc_id If span_adjacent is TRUE, The document ids are required to ensure that tags do not span from one document to another.
#'
#' @return a character vector of color-tagged tokens
#' @export
#' @examples
#' tokens = c('token_1','token_2','token_3','token_4')
#' category = c('a','a',NA,'b')
#' category_highlight_tokens(tokens, category)
category_highlight_tokens <- function(tokens, category, labels=NULL, alpha=0.4, class=NULL, colors=NULL, unfold=NULL, span_adjacent=F, doc_id=NULL) {
tokens = gsub('[<>]', '', tokens)
ncategories = length(unique(stats::na.omit(category)))
if (methods::is(category, 'character')) category = factor(category, labels=stats::na.omit(unique(category)))
if (methods::is(category, 'numeric')) {
if (is.null(labels)) stop('If category is numeric, labels must be provided')
if (max(category, na.rm = T) > length(labels)) stop('The maximum category value is higher than the number of labels')
}
if (methods::is(category, 'factor')) {
if (is.null(labels)) labels = levels(category)
category = as.numeric(category)
}
if (is.null(colors)) colors = grDevices::rainbow(ncategories)
if (!length(colors) == ncategories) stop(sprintf('The number of colors (%s) is not equal to the number of categories (%s)', length(colors), ncategories))
if (length(alpha) == 1) alpha = rep(alpha, length(category))
tcolor = colors[category]
alpha[is.na(tcolor)] = NA
col = highlight_col(alpha, col=tcolor)
tokens = tag_tokens(tokens,
class=class,
style = attr_style(`background-color` = col),
title = labels[category],
unfold=unfold,
span_adjacent=span_adjacent, doc_id=doc_id)
#tokens = tag_tokens(tokens, 'a', tag_attr(href = stringi::stri_paste('#nav', category, sep='')),
# span_adjacent=T)
tokens
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.