# Identify functions that should not be tested, including quit(), q() and install.packages().
# Replace all occurrences with commented function
clean_script <- function(file, message = FALSE, target = c("rmd", "html")) {
target <- match.arg(target)
noRunFunctions <- c(
"quit",
"readClipboard",
"RSiteSearch",
"install.packages",
"update.packages",
"savehistory",
"source",
"loadhistory",
"findFn",
"vignette",
"png",
"trellis.device",
"dev.off",
"save",
"load"
)
ptn <- sprintf(
"^!( *#* *).*%s",
paste0("(", noRunFunctions, "\\(", ")", collapse = "|")
)
ptn <- sprintf(
"^[^ #]*.*(%s)\\(",
paste(noRunFunctions, collapse = "|")
)
if (!file.exists(file)) stop("file doesn't exist")
txt <- scan(file,
what = "character",
sep = "\n",
quiet = TRUE,
blank.lines.skip = FALSE
)
# Remove fancy quotes
txt <- gsub("’", "'", txt, useBytes = TRUE) ## fancy single quote
txt <- gsub("’", "'", txt, useBytes = FALSE) ## fancy single quote
# Remove hard space
txt <- gsub("", "", txt, useBytes = TRUE) ## weird hard space
nonAsciiSpace <- "\xef\xbb\xbf"
Encoding(nonAsciiSpace) <- "latin1"
Encoding(txt) <- "latin1"
txt <- gsub(nonAsciiSpace, " ", txt)
Encoding(txt) <- "ASCII"
# Comment lines containing noRunFunctions
idx <- grep(ptn, txt, perl = TRUE)
if (length(idx) > 0) {
if (target == "html") {
txt[idx] <- paste("##", txt[idx], sep = " ")
} else {
txt[idx] <- paste("\\dontrun{", txt[idx], "}", sep = "\n")
}
if (message) {
cat(txt[idx], sep = "\n")
cat(txt[idx], sep = "\n")
}
}
Encoding(txt) <- "ascii"
txt
}
# Run clean_script for all scripts in inst/scripts/1-orig, putting cleaned version in inst/scripts/2-clean
clean_all_scripts <- function(scriptPath = here::here("inst/scripts/1-orig"),
outPath, comment = TRUE, message = TRUE) {
if (!file.exists(scriptPath)) {
stop("script path doesn't exist")
}
scripts <- normalizePath(list.files(scriptPath,
pattern = "\\.[Rr]$",
full.names = TRUE
))
clean <- lapply(scripts, clean_script, message = message)
ret <- sapply(seq_along(scripts), function(i) {
newFile <- file.path(outPath, basename(scripts[i]))
if (message) message(newFile)
txt <- paste(clean[[i]], collapse = "\n")
txt <- paste("if (interactive() || is.na(Sys.getenv('NOT_CRAN', unset = NA)) ) {", txt, "}", sep = "\n")
writeLines(txt, con = newFile)
newFile
})
invisible(ret)
}
clean_all_scripts(
scriptPath = here::here("inst/scripts/1-orig"),
outPath = here::here("inst/scripts/2-clean")
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.