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."))
}
警告!它适用于我的用例,但它可能会在您的用例中失败。
我有一个 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."))
}
警告!它适用于我的用例,但它可能会在您的用例中失败。