按类型打印data.frame列和颜色

Question

在我的Knitted文档中，我正在尝试打印数据框的列。为了帮助实现可视化，我想根据另一列的值更改输出颜色。我有一个简单的例子如下。

date_vector <- rep(NA, 10)
type_vector <- rep(NA, 10)
types <- c("A", "B")
CDate <- Sys.Date()
date_vector[1] <- as.character(CDate)
type_vector[1] <- sample(types, size = 1)
for (i in 2:10) {
  CDate <- as.Date(CDate) + rexp(n = 1, rate = 1/5)
  date_vector[i] <- as.character(CDate)
  type_vector[i] <- sample(types, size = 1)
}

test_df <- data.frame(Date=date_vector, Type=type_vector)

当我打印test_df$Date时，我会看到以下内容

date_vector
[1] "2016-01-06" "2016-01-07" "2016-01-22" "2016-01-28" "2016-01-29" "2016-02-01" "2016-02-04"
[8] "2016-02-12" "2016-02-13" "2016-02-15"

相反，希望看到以下内容

由于条目的类型如下

type_vector
[1] "A" "A" "B" "B" "A" "A" "B" "A" "B" "A"

因此，蓝色表示类型为A的日期，绿色表示类型为B的日期。

Answer 1

这个答案比问题更通用。该问题要求根据另一列为数据框的一列着色。这个答案解决了在向量中突出显示元素的更一般情况，具体取决于指示要突出显示哪些元素的第二个逻辑向量。

原则上，这非常简单：打印一个矢量，突出显示另一个逻辑矢量所指示的元素。突出显示x可以简单到将其包含在\\textcolor{blue}{x}或\\emph{x}中。

在实践中，它并不那么简单...... print(x)做了很多有用的事情：它在列中很好地排列数据，在字符数据周围添加引号，将输出包装起来{{1} }，将第一个元素的索引添加到每行输出，依此类推。问题是，我们无法使用getOption("width)打印突出显示的数据，因为print会转义print中的反斜杠。此问题的standard solution是使用\\textcolor而不是cat。但是，print不适用上面列出的任何优秀格式。

因此，挑战在于编写一个能够再现cat的某些/所需特征的函数。这是一个非常复杂的任务，因此我将自己局限于以下主要功能：

• 总行宽print。
• 自动在非数字和非逻辑值周围添加引号（如果未设置<= getOption("width")）。
• 将第一个元素的索引添加到每行输出（如果quote）。
• 将舍入应用于数字输入（printIndex = TRUE）。

另外，这两个突出显示功能：

• 在{＆＃34;突出显示模式＆＃34;
中包裹digits所指示的x元素
• 计算线宽时，请勿考虑突出显示模式。这假设突出显示仅添加标记但没有可见输出。

请注意，此函数缺少condition的重要功能，例如处理缺失值。此外，它将输入print转换为字符（通过x）。结果可能与as.character不同，因为根本不使用与输入类对应的S3方法（print）。

print.*

要将此功能与printHighlighted <- function(x, condition = rep(FALSE, length(x)), highlight = "\\emph{%s}", printIndex = TRUE, width = getOption("width"), digits = getOption("digits"), quote = NULL) { stopifnot(length(x) == length(condition)) stopifnot(missing(digits) || (!missing(digits) && is.numeric(x))) # Raise error when input is non-numeric but "digits" supplied. if (missing(quote)) { if (is.numeric(x) || is.logical(x)) { quote <- FALSE } else { quote <- TRUE } } nquotes <- 0 if (!printIndex) { currentLineIndex <- "" } if (is.numeric(x)) { x <- round(x, digits = digits) } fitsInLine <- function(x, elementsCurrentLine, currentLineIndex, nquotes, width) { return(sum(nchar(x[elementsCurrentLine])) + # total width of elements in current line nchar(currentLineIndex) + # width of the index of the first element (if shown) sum(elementsCurrentLine) - 1 + # width of spaces between elements nquotes <= # width of quotes added around elements width) } x <- as.character(x) elementsCurrentLine <- rep(FALSE, times = length(x)) for (i in seq_along(x)) { if (!any(elementsCurrentLine) && printIndex) { # this is a new line AND show index currentLineIndex <- sprintf("[%s] ", i) } elementsCurrentLine[i] <- TRUE # Add element i to current line. Each line holds at least one element. Therefore, if i is the first element of this line, add it regardless of line width. If there already are elements in the line, the previous loop iteration checked that this element will fit. if (i < length(x)) { # not the last element # check whether next element will fit in this line elementsCurrentLineTest <- elementsCurrentLine elementsCurrentLineTest[i + 1] <- TRUE if (quote) { nquotes <- sum(elementsCurrentLineTest) * 2 } if (fitsInLine(x, elementsCurrentLineTest, currentLineIndex, nquotes, width)) { next # Next element will fit; do not print yet. } } # Next element won't fit in current line. Print and start a new line. # print toPrint <- x[elementsCurrentLine] toMarkup <- condition[elementsCurrentLine] toPrint[toMarkup] <- sprintf(fmt = highlight, toPrint[toMarkup]) # add highlighting if (quote) { toPrint <- sprintf('"%s"', toPrint) } cat(currentLineIndex) cat(toPrint) cat("\n") # clear line elementsCurrentLine <- rep(FALSE, times = length(x)) } } 一起使用，必须使用chunk option knitr，否则输出将包含在results = "asis"环境中，其中负责突出显示的标记为显示而不是使用。

最后，要重现普通块的外观，请将整个块包装在

中

verbatim

实施例

为了节省一些空间，该示例假设\begin{knitrout} \definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor} \begin{kframe} \begin{alltt} <<your-chunk>>= printHighlighted(...) @ \end{alltt} \end{kframe} \end{knitrout} 的函数定义在文件printHighlighted中可用。

printHighlighted.R

事实证明这是相当长的......如果有人认为这对于这么简单的问题来说太过分了，我很乐意看到更短的解决方案。