基于对象颜色将R代码渲染为HTML的技术求助

需求说明 #

将封装在GEMMA_MODEL_V0函数中的大型非线性求解模型代码渲染为HTML，满足以下要求：

• 属于NOM列表的对象标记为蓝色
• 属于CLS列表的对象标记为红色
• 属于SHK列表的对象标记为绿色（#33b54e）
• 跳过所有以EQ_开头的字符串
• 仅高亮完整匹配的字符串

当前实现代码 #

rmd_file <- "GEMMA_MODEL_V0_Markdown.Rmd"
NOM <- unique(LST$Object)
CLS <- unique(CLOSURE$Object)
SHK <- unique(GEMMA_SWAP_SHOCK$Object)  # Assuming SHK is a data frame similar to CLOSURE

cat(
  "---
title: 'GEMMA Model V0'
output: html_document
---

<style>
pre {
  white-space: pre-wrap;       /* CSS3 */
  white-space: -moz-pre-wrap;  /* Firefox */
  white-space: -pre-wrap;      /* Opera */
  white-space: -o-pre-wrap;    /* Opera */
  word-wrap: break-word;       /* IE */
}
</style>

```{r, echo=FALSE, results='asis'}
highlight_code <- function(code, nom, cls, shk) {
  for (str in nom) {
    code <- gsub(paste0('(?<!EQ_)', '\\b', str, '\\b'), paste0('<span style=\"color:blue\">', 
str, '</span>'), code, perl = TRUE)
  }
  for (str in cls) {
    code <- gsub(paste0('(?<!EQ_)', '\\b', str, '\\b'), paste0('<span style=\"color:red\">', 
str, '</span>'), code, perl = TRUE)
  }
  for (str in shk) {
    code <- gsub(paste0('(?<!EQ_)', '\\b', str, '\\b'), paste0('<span 
style=\"color:#33b54e\">', str, '</span>'), code, perl = TRUE)
  }
  return(code)
}
# Ensure your function is in the global environment
# Display the function code
code <- paste(capture.output(GEMMA_MODEL_V0), collapse = '\\n')
highlighted_code <- highlight_code(code, NOM, CLS, SHK)
cat('<pre>', HTML(highlighted_code), '</pre>')
```", file = rmd_file)

rmarkdown::render(rmd_file, output_format = "html_document")

问题分析 #

当前代码存在三个核心问题：

1. 循环替换可能导致已高亮的字符串被重复匹配（比如<span>标签中的文本被再次处理）
2. \b单词边界对包含特殊字符的对象匹配不准确
3. HTML()函数会转义HTML标签，导致高亮样式失效

修改后的解决方案 #

完整代码 #

rmd_file <- "GEMMA_MODEL_V0_Markdown.Rmd"
NOM <- unique(LST$Object)
CLS <- unique(CLOSURE$Object)
SHK <- unique(GEMMA_SWAP_SHOCK$Object)

cat(
  "---
title: 'GEMMA Model V0'
output: html_document
---

<style>
pre {
  white-space: pre-wrap;
  white-space: -moz-pre-wrap;
  white-space: -pre-wrap;
  white-space: -o-pre-wrap;
  word-wrap: break-word;
}
</style>

```{r, echo=FALSE, results='asis'}
highlight_code <- function(code, nom, cls, shk) {
  # 构建颜色映射表：后定义的规则会覆盖重复项，可根据优先级调整顺序
  color_map <- c(
    setNames(rep("blue", length(nom)), nom),
    setNames(rep("red", length(cls)), cls),
    setNames(rep("#33b54e", length(shk)), shk)
  )
  
  # 转义正则特殊字符，避免匹配出错
  escaped_strings <- sapply(names(color_map), function(x) {
    gsub("([\\.\\*\\+\\?\\|\\(\\)\\[\\]\\{\\}\\\\])", "\\\\\\1", x)
  })
  
  # 构建正则模式：匹配完整单词，且不以EQ_开头
  pattern <- paste0(
    "(?:^|(?<![a-zA-Z0-9_]))",  # 匹配单词开头（非字母数字下划线或行首）
    "(?!EQ_)",                   # 排除以EQ_开头的字符串
    "(", paste(escaped_strings, collapse = "|"), ")",  # 匹配目标字符串
    "(?![a-zA-Z0-9_])"           # 匹配单词结尾（非字母数字下划线或行尾）
  )
  
  # 自定义替换逻辑
  replace_func <- function(match) {
    paste0('<span style="color:', color_map[match], '">', match, '</span>')
  }
  
  # 执行一次性替换
  gsub(pattern, replace_func, code, perl = TRUE)
}

# 获取函数代码
code <- paste(capture.output(GEMMA_MODEL_V0), collapse = '\n')
# 生成高亮代码
highlighted_code <- highlight_code(code, NOM, CLS, SHK)
# 输出HTML（无需HTML()转义）
cat('<pre>', highlighted_code, '</pre>')
```", file = rmd_file)

rmarkdown::render(rmd_file, output_format = "html_document")

关键修改点 #

1. 一次性正则匹配：将所有目标字符串合并为一个正则表达式，避免循环替换导致的重复高亮问题
2. 正则转义处理：对目标字符串中的特殊字符（如.、*）进行转义，确保匹配准确
3. 精确边界控制：用(?<![a-zA-Z0-9_])和(?![a-zA-Z0-9_])替代\b，更精准地匹配完整单词
4. 移除HTML()转义：直接输出原始HTML标签，确保高亮样式正常生效
5. 优先级控制：颜色映射表的顺序决定重复字符串的高亮颜色，可根据需求调整顺序

内容的提问来源于stack exchange，提问作者Zac