Rmarkdown 将非生成的图像复制为资产

Rmarkdown copy non-generated images as assets

我有一个 Rmarkdown 文件,其中包含图像的降价链接(不是在 R 中生成的)。例如;

![](./data/method1/results/bla.png)

 And results show:

![](./data/method2/distances/average/avg.png)
...

当我使用 self_contained:true 渲染到 HTML 时,生成的 html 文件是可移植的,一切都很好。但是当我使用 self_contained:false 时,html 文件不可移植,因为图像位于不同的位置。是否有一个选项可以收集所有引用的图像并将它们复制到相对于 Rmd 文件的本地资产目录,例如 ./images/

我没有使用knitr::include_graphics()或手动复制它们,因为有数百张图像。

想出了解决办法。

library(stringr)

#' @title portify
#' @description Copies markdown liked files in Rmd as portable assets and renames markdown paths in Rmd
#' @param path <Character> Path to Rmd file
#' @param path_out <Character> Path to new Rmd file
#' @param dirname <Character> Name for portable images directory
#' @param overwrite_dir <Logical> Should the portable images directory be overwritten if it exists?
#' @param pattern <Character> Regular expression pattern used to find markdown image links in Rmd
#' @details Makes Rmd with markdown linked images portable. Images are copied over from source location to a local directory named dirname keeping the source directory structure. The image paths are corrected in the Rmd file and a new Rmd file is created.
#' @examples 
#' \donotrun{
#' portify("report.Rmd")
#' }
#' 
portify <- function(path, path_out=NULL, dirname="markdown_images", overwrite_dir=FALSE, pattern="!\[[^\]]*\]\(([^'\"\)]*)\)"){
  
  x <- readLines(path)
  pos <- str_which(x, pattern)
  path_from <- str_match(x[pos], pattern)[,2]
  dir_to <- file.path(dirname(path), dirname)
  
  # remove dir recursively if it exists and overwrite_dir=T
  if(dir.exists(dir_to) & overwrite_dir){
    unlink(dir_to,recursive=TRUE)
    message(paste("Removing directory", dir_to,"."))
  }
  
  # create dir if it doesn't exist
  if(!dir.exists(dir_to)) {
    dir.create(dir_to)
    message(paste("Directory", dir_to,"created."))
  }
  
  # expects images to use relative links in Rmd
  path_to <- file.path(dir_to, path_from)
  subdir_to <- dirname(path_to)
  
  # remove subdir recursively if it exists and overwrite_dir=T
  if(overwrite_dir) invisible(lapply(subdir_to, function(x) if(dir.exists(x)) unlink(x, recursive=TRUE)))
  
  # create subdir if it doesn't exist
  invisible(lapply(subdir_to, function(x) if(!dir.exists(x)) dir.create(x, recursive=TRUE)))
  
  # copy files from source to destination
  file.copy(from=path_from, to=path_to, copy.date=TRUE)

  # replace old links with new links
  path_md <- paste0("![](", path_to,")")
  x[pos] <- str_replace(x[pos], pattern, path_md)
  
  if(is.null(path_out)) path_out <- str_replace(path,".Rmd","-port.Rmd")
  writeLines(x, path_out)
  message(paste(path_out, "created."))
}

警告!它适用于我的用例,但它可能会在您的用例中失败。