Skip to content

Instantly share code, notes, and snippets.

@brshallo
Last active December 7, 2022 13:15
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save brshallo/e963b9dca5e4e1ab12ec6348b135362e to your computer and use it in GitHub Desktop.
Save brshallo/e963b9dca5e4e1ab12ec6348b135362e to your computer and use it in GitHub Desktop.
Function for sourcing individual or multiple chunks from an RMD document
library(magrittr)
library(stringr)
library(readr)
library(purrr)
library(glue)
library(knitr)
source_rmd_chunks <- function(file, chunk_labels, skip_plots = TRUE, output_temp = FALSE){
temp <- tempfile(fileext=".R")
knitr::purl(file, output = temp)
text <- readr::read_file(temp)
text <- purrr::map(chunk_labels, ~stringr::str_extract(text, glue::glue("(## ----{var})(.|[:space:])*?(?=(## ----)|$)", var = .x))) %>%
stringr::str_c(collapse = "\n")
readr::write_file(text, temp)
if(skip_plots) {
old_dev = getOption('device')
options(device = function(...) {
.Call("R_GD_nullDevice", PACKAGE = "grDevices")
})
}
source(temp)
if(skip_plots) {
options(device = old_dev)
}
if(output_temp) temp
}
@brshallo
Copy link
Author

brshallo commented Apr 1, 2021

See this thread: https://stackoverflow.com/questions/41962434/source-code-from-rmd-file-within-another-rmd (may need to make some changes to make more workable for use when knitting).

Also see link to gist by Noam Ross that I used as starting point: https://gist.github.com/noamross/a549ee50e8a4fd68b8b1

@brshallo
Copy link
Author

If sourcing from github file, remember to use the "raw " file.

@py9mrg
Copy link

py9mrg commented Mar 8, 2022

Hello @brshallo

This is really helpful for what I want to do, thanks! One quick question/comment, have you considered making a PR to knitr for this? I think it would be really helpful to have this as part of the standard package.

Edit: oh also I noticed a potential improvement in the regex. As you currently have:

text <- purrr::map(chunk_labels, ~stringr::str_extract(text, glue::glue("(## ----{var})(.|[:space:])*?(?=(## ----)|$)", var = .x))) %>% 
    stringr::str_c(collapse = "\n")

It can get confused with chunk labels that start the same. For example, if I have labels that are tuning and tuning-grid and I put in the chunk label as just "tuning" then, in my case, it will only find the tuning-grid chunk (presumably because this one comes first) and never return the tuning chunk (unless I hack it by putting something like "tuning----" as the chunk label to find). But this can be mitigated by changing the regex to:

text <- purrr::map(chunk_labels, ~stringr::str_extract(text, glue::glue("(## ----{var}----)(.|[:space:])*?(?=(## ----)|$)", var = .x))) %>% 
    stringr::str_c(collapse = "\n")

(i.e. changing ----{var} to ----{var}----)

Edit 2 - balls, that idea doesn't work if there are any chunk options... so now it has to be something like:

text <- purrr::map(chunk_labels, ~stringr::str_extract(text, glue::glue("(## ----{var})(----|,|.|[:space:])*?(?=(## ----)|$)", var = .x))) %>% 
    stringr::str_c(collapse = "\n")

But now we're back at tuning-grid not tuning being found! I'm not great with regex so I'll keep working on it.

Ok, I think this works, at least it does for me. From my limited regex understanding this should exclude any chunks where var is followed by a single hyphen or single underscore and then any letter or digit. So searching for a chunk called tuning won't accidentally pick up tuning-grid or tuning-2 or tuning_grid, you'd have to actually specify those full chunk names. But I'm not sure how robust it is - as long as no one ever names a chunk something like tuning--grid!

text <- purrr::map(chunk_labels, ~stringr::str_extract(text, glue::glue("(## ----{var})(?!(-|_)([a-z]|[A-Z]|[:digit:]))(----|,|.|[:space:])*?(?=(## ----)|$)", var = .x))) %>% 
    stringr::str_c(collapse = "\n")

I don't think I need all the options in (----|,|.|[:space:]) but I'm trying to explicitly cover all the cases that might occur. For me it works without all of these anyway.

@brshallo
Copy link
Author

@py9mrg I wasn't really planning on it. My impression is Yihui isn't crazy about knitr::purl() so didn't know if he'd want to incorporate support for something like this...

Wouldn't hurt to open an issue though, feel free to @ me on jt.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment