#' myknit
#'
#' myknit can be used to make the process of knitting more flexible.
#' The Usage and Arguments section specify how the function would be used on a standalone base. \cr\cr
#' Normally however I do the \code{knit} with the **knit** button in RStudio.
#' When I include in the yaml metadata block the yaml statement \cr
#' \code{knit: (function (...) \{ HOQCutil::myknit(...) \})}
#' the \code{myknit} code will be run instead of \code{rmarkdown::render}.\cr\cr
#' The \code{myknit} function removes (R) commented lines from the yaml metadata block and can do one or more of the following things (based on extra YAML statements): \cr
#' * specify an alternative name for the output file (based on \code{hoqc_output})
#' * append a version indicator to the name of the output file (based on \code{hoqc_version})
#' * force that the proper extension is given to the name of the output file (when not specified) (based on \code{hoqc_force_ext})
#' * create a file with the yaml metadata block that was specified with a name including the version indicator (based on \code{hoqc_yaml})
#' * create a file with the yaml metadata block after processing with a name including the version indicator (based on \code{hoqc_yaml_new})
#' * create a copy of the input file with a name including the version indicator (based on \code{hoqc_rmd_in})
#' * create a copy of the processed input file with a name including the version indicator (based on \code{hoqc_rmd_out})
#' An example of use is given in the
#' [pdf file](https://github.com/HanOostdijk/rmd_pdf_examples/blob/master/output/Flex/%20Knit_v1.pdf)
#' and the corresponding
#' [rmd file](https://github.com/HanOostdijk/rmd_pdf_examples/blob/master/flexknit.Rmd) of the GitHub repository
#' **rmd_pdf_examples**.\cr
#' Note: in the repository the myknit function is (still) included as a separate function.
#'
#' @param inputFile base file to render
#' @param encoding encoding of basefile
#' @param hoqc_render boolean to indicate that output file is to be created. Default TRUE
#' @param clean boolean to indicate that intermediary files are removed. Default TRUE
#' @importFrom magrittr %>%
#' @importFrom utils head tail
#' @importFrom rmarkdown render
#' @export
myknit <-
function (inputFile,
encoding = getOption("encoding"),
hoqc_render = TRUE,
clean = TRUE) {
# Acknowledgement: idea comes from
# https://stackoverflow.com/questions/39885363/importing-common-yaml-in-rstudio-knitr-document
# read in the src file
rmd <- readLines(inputFile)
# the line numbers of the start and end line for the yaml section
yaml_ind <- stringr::str_which(rmd, '^---$')[1:2]
# retrieve the yaml metadata block
yaml_org <- rmd[do.call(seq.int, as.list(yaml_ind))]
yaml <- yaml_org
# remove yaml lines beginning with '#' or ' #'
yaml <- yaml[!stringr::str_detect(yaml, '^[ ]*#')]
# first document type determines the output type
doctype_line <-
c(stringr::str_subset(yaml, 'pdf_document|html_document'),
'html_document')[1]
doc_type <- stringr::str_match(doctype_line, '(pdf|html)_document')[1, 2]
# specify the additional yaml options
hoqc_items <-
c(
'hoqc_output',
'hoqc_yaml',
'hoqc_yaml_new',
'hoqc_force_ext',
'hoqc_version' ,
'hoqc_rmd_in' ,
'hoqc_rmd_out' ,
'hoqc_render'
)
# read the values of the hoqc_* options and remove the options from yaml
values <- list()
for (hoqc_item in hoqc_items) {
mks <- myknit_search(yaml, hoqc_item)
yaml <- mks[['new_yaml']]
values[[hoqc_item]] <- mks[['value']]
}
# insert params: hoqc_version
if (!is.null(values[['hoqc_version']])) {
hoqc_version = values[['hoqc_version']]
} else {
hoqc_version = ''
}
if (!is.null(values[['hoqc_force_ext']]))
hoqc_force_ext <- values[['hoqc_force_ext']]
else
hoqc_force_ext <- ''
# if requested create file with copy of Rmd input
if (!is.null(values[['hoqc_rmd_in']])) {
hoqc_rmd_in <- values[['hoqc_rmd_in']]
hoqc_rmd_in <-
myknit_force_ext(hoqc_rmd_in, 'Rmd', TRUE, hoqc_version)
# write new input to the indicated file
writeLines(rmd, hoqc_rmd_in)
} else
hoqc_rmd_in <- ''
# if requested create file with copy of Rmd input
if (!is.null(values[['hoqc_rmd_out']])) {
hoqc_rmd_out <- values[['hoqc_rmd_out']]
hoqc_rmd_out <-
myknit_force_ext(hoqc_rmd_out, 'Rmd', TRUE, hoqc_version)
} else
hoqc_rmd_out <- ''
# if requested create file with original yaml contents
if (!is.null(values[['hoqc_yaml']])) {
hoqc_yaml <- values[['hoqc_yaml']]
hoqc_yaml <-
myknit_force_ext(hoqc_yaml, 'txt', hoqc_force_ext, hoqc_version)
# write new input to the indicated file
writeLines(yaml_org, hoqc_yaml)
} else
hoqc_yaml <- ''
# if requested create file to contain new yaml contents
if (!is.null(values[['hoqc_yaml_new']])) {
hoqc_yaml_new <- values[['hoqc_yaml_new']]
hoqc_yaml_new <-
myknit_force_ext(hoqc_yaml_new, 'txt', hoqc_force_ext, hoqc_version)
# because yaml will be extended with params do not yet write to the file
# writeLines(yaml, hoqc_yaml_new)
} else
hoqc_yaml_new <- ''
# determine output name for pdf or html file
if (!is.null(values[['hoqc_output']])) {
hoqc_output = values[['hoqc_output']]
hoqc_output = myknit_force_ext(hoqc_output, doc_type, hoqc_force_ext, hoqc_version,
hoqc_render = hoqc_render)
} else {
inputFileb <- strsplit(inputFile, '.', fixed = T)[[1]][1]
hoqc_output = myknit_force_ext(inputFileb, doc_type, hoqc_force_ext, hoqc_version,
hoqc_render = hoqc_render)
}
# create the additional params lines
# hoqc_render only in params when false (empties are removed)
hoqc_render2 <- hoqc_render
if (hoqc_render == TRUE)
hoqc_render = ''
else
hoqc_render = 'false'
# ensure that all options have the same length after padding
hoqc_items <-
stringr::str_pad(hoqc_items, max(sapply(hoqc_items, stringr::str_length)), side = 'right')
hoqc_values <-
lapply(hoqc_items, function(x)
eval(parse(text = x)))
# remove the empty options
hoqc_items <- hoqc_items[stringr::str_length(hoqc_values) > 0]
hoqc_values <- hoqc_values[stringr::str_length(hoqc_values) > 0]
# format the param lines
hoqc_parms <-
paste(hoqc_items, paste0("'", hoqc_values, "'"), sep = ' : ')
# insert params
# locate params line and lines not starting with space
parmline <- stringr::str_which(yaml, '^params[ ]*:')
nbline <- stringr::str_which(yaml, '^[^ ]')
if (length(parmline) == 0) {
# when params line not found then add it with
# hoqc_version line at the end of the yaml block
yaml <-
append(yaml, c('params: ', paste0(' ', hoqc_parms)), after = utils::tail(nbline, 1) -
1)
} else {
# when params line found then add hoqc_* lines at the end of the params block
nbline <- utils::head(nbline[nbline > parmline[1]], 1)
lpline <- yaml[nbline - 1]
# ensure that the hoqc_version line starts with the correct number of spaces
lpline <-
paste0(strrep(' ', as.numeric(regexec('[^ ]', lpline)) - 1), hoqc_parms)
yaml <- append(yaml, lpline, after = nbline - 1)
}
# write modified yaml to file if requested
if (!is.null(values[['hoqc_yaml_new']])) {
writeLines(yaml, hoqc_yaml_new)
}
# combine changed yaml with payload
inputNew <-
append(yaml, rmd[(yaml_ind[2] + 1):length(rmd)])
# write new input to a temp file
if (stringr::str_length(hoqc_rmd_out) == 0)
tfile <- fs::file_temp(pattern = 'tmpfile',
tmp_dir = '.',
ext = '.Rmd')
else
tfile = hoqc_rmd_out
writeLines(inputNew, tfile)
# render adjusted file with rmarkdown.
if (hoqc_render2 == TRUE) {
ofile <-
rmarkdown::render(
tfile,
encoding = encoding,
output_file = hoqc_output,
envir = new.env(),
clean = clean
)
# remove temporary file
if (stringr::str_length(hoqc_rmd_out) == 0)
fs::file_delete(tfile)
}
}
myknit_force_ext <- function (filename, doc_type, tf, suffix, hoqc_render=TRUE) {
# optionally give an extension or suffix to filename
# ensure tf becomes a logical variable
tf1 <- as.logical(tf)
if (is.na(tf1))
tf1 = switch(tolower(tf), yes = T, no = F, T)
# do not consider path
filename1 <- basename(filename)
dirname1 <- dirname(filename)
# split proper name and extension
ibe <- strsplit(filename1, '.', fixed = T)
# unpack the list
ibe <- ibe[[1]]
# append suffix to proper name
ibe[1] <- paste0(ibe[[1]][1], suffix)
# if extension is required add the given one (will only be used when length(ibe) ==1)
if (tf1 == TRUE)
ibe <- c(ibe, doc_type)
# new filename
if (length(ibe) < 2)
newname <- ibe
else
newname <- paste(ibe[1:2], collapse = '.')
# ensure that folders exist and retrieve the full name
newname <- paste(dirname1, newname, sep = '/')
newname %>% fs::path_dir() %>% fs::dir_create()
already_there <- fs::file_exists(newname)
newname %>% fs::file_create() %>% fs::path_real() %>% as.character() -> newname
if ((doc_type %in% c('pdf','html')) && (hoqc_render == F) && (already_there == F) ) {
# remove file created here that will not be used
fs::file_delete(newname)
}
newname
}
myknit_search <- function(yaml, yaml_keyword) {
# read the values of the keyword and remove the keyword line from yaml
value <- NULL
# prepare grep pattern
g1 <- sprintf('%s[ ]*:[ ]*', yaml_keyword)
# look for keyword
ofound <- stringr::str_which(yaml, g1)
# if there is exactly one such line then retrieve its value
if (length(ofound) == 1) {
# the hoqc_output line
keyline <- yaml[ofound]
# the part after the colon
after_colon <- stringr::str_match(keyline, paste0(g1, '(.*)'))[1, 2]
# retrieve the value
value <- myknit_search2(after_colon)
# remove the line containing the keyword
yaml <- yaml[-ofound]
}
# return the keyword value and the yaml without the keyword line
list('new_yaml' = yaml, 'value' = value)
}
myknit_search2 <- function(after_colon) {
# find option value
# comments refer to cases in test_myknit_search
if (stringr::str_detect(after_colon, "\"`[rR]")) { #keyword5
value <- stringr::str_match(after_colon, "\"`[rR]([^`]*)`\"")
value[[2]] = eval(parse(text=value[[2]]))
} else if (stringr::str_detect(after_colon, "\'`[rR]")) { #keyword4
value <- stringr::str_match(after_colon, "\'`[rR]([^`]*)`\'")
value[[2]] = eval(parse(text=value[[2]]))
} else if (stringr::str_detect(after_colon, "\'")) { #keyword2
value <- stringr::str_match(after_colon, "[\']([^\']*)[\']")
} else if (stringr::str_detect(after_colon, '\"')) { #keyword1
value <- stringr::str_match(after_colon, '[\"]([^\"]*)[\"]')
} else { #keyword0 and keyword3
value <- stringr::str_match(after_colon, '([^ #]*)')
}
value[2]
}
test_myknit_search <- function (){
# test function for the various cases in myknit_search
yaml <- c('keyword1 : "ni hao"',
"keyword2: 'hello'",
"keyword3: hallo",
"keyword4:'`r format(Sys.time(), \'_%Y%m%d\')`'",
'keyword5:"`r format(Sys.time(), \"_%Y%m%d\")`"'
)
print(myknit_search(yaml,'keyword0'))
print(myknit_search(yaml,'keyword1'))
print(myknit_search(yaml,'keyword2'))
print(myknit_search(yaml,'keyword3'))
print(myknit_search(yaml,'keyword4'))
print(myknit_search(yaml,'keyword5'))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.