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

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

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)

相反，我希望看到以下内容

因为条目的类型如下

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

---

因此，蓝色表示日期，类型为

A

，绿色表示日期，类型为

B

，这个答案比问题更一般。该问题询问如何根据另一列为数据帧的一列着色。这个答案解决了更一般的情况，即根据指示要高亮显示哪些元素的第二个逻辑向量高亮显示向量中的元素

---

原则上，这很简单：打印一个向量，突出显示另一个逻辑向量指示的元素。突出显示

x

非常简单，只需将其包装在

\\textcolor{blue}{x}

或

\\emph{x}

中即可

实际上，它并不是那么简单…

print（x）

做了很多有用的事情：它将数据很好地排列在列中，在字符数据周围添加引号，将输出包装为尊重

getOption（“宽度”）

，将第一个元素的索引添加到输出的每一行，依此类推。问题是，我们不能使用

print

打印突出显示的数据，因为

print

会在

\\textcolor

中转义反斜杠。这个问题的解决方法是使用

cat

而不是

print

。但是，

cat

不会不要应用上面列出的任何漂亮的格式

因此，挑战在于编写一个函数来重现

print

的一些/所需功能。这是一项相当复杂的任务，因此我仅限于以下主要功能：

---

• 总行宽

  这个问题似乎与LaTeX无关。请注意，关于R和stuff的问题只涉及与LaTeX相关的部分，这里似乎不是这样。谢谢。这个问题也与knitr相关，所以我想在这里发布。我可以将这个问题迁移到stackoverflow吗？或者我需要要重新打字吗？
  type_vector
  [1] "A" "A" "B" "B" "A" "A" "B" "A" "B" "A"
  
  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))
    }
  }
  
  \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}
  
  \documentclass{article}
  \begin{document}
  
  Some text ....
  
  \begin{knitrout}\definecolor{shadecolor}{rgb}{0.969, 0.969, 0.969}\color{fgcolor}\begin{kframe}\begin{alltt}
  <<results = "asis", echo = FALSE>>=
  source("printHighlighted.R")
  data <- seq(from = as.Date("2015-01-15"), by = "day", length.out = 100)
  cond <- rep(FALSE, 100)
  cond[c(3, 55)] <- TRUE
  
  printHighlighted(x = data, condition = cond, highlight = "\\textcolor{blue}{%s}", width = 60)
  @
  \end{alltt}\end{kframe}\end{knitrout}
  
  Some text ....
  
  \end{document}