Here are the examples of the r api knitr-:split_file taken from open source projects. By voting up you can indicate which examples are most useful and appropriate.
2 Examples
19
File: utils-rmd.R, author: datacamp, license: GNU Affero General Public License v3.0
build_doc_structure < - function(text) {
old.format < - knitr::opts_knit$get()
knitr::opts_knit$set(out.format = "markdown")
apat < - knitr::all_patterns
opat < - knitr::knit_patterns$get()
on.exit({
knitr::knit_patterns$restore(opat)
knitr:::chunk_counter(reset = TRUE)
knitr:::knit_code$restore(list())
knitr::opts_knit$set(old.format)
})
knitr::pat_md()
content = knitr:::split_file(lines = knitr:::split_lines(text))
code_chunks < - knitr:::knit_code$get()
for (i in seq_along(content)) {
if (class(content[[i]]) == "block") {
label < - content[[i]]$params$label
content[[i]]$input < - paste(code_chunks[[label]],
collapse = "\n")
}
}
content[sapply(content, function(part) {
all(grepl(pattern = "^\\s*$", x = part$input.src)) &&
class(part) == "inline"
})] < - NULL
return(content)
}
19
File: ReactorNotebook.R, author: herbps10, license: Apache License 2.0
ReactorNotebook < - R6Class("ReactorNotebook", public = list(cells = list(),
static_dir = "", initialize = function(static_dir = tempdir()) {
private$env < - new.env()
self$static_dir < - static_dir
}, run_in_env = function(code) {
eval(parse(text = code), private$env)
}, move = function(source, destination) {
self$cells < - map(self$cells, function(cell) {
if (cell$position == source) cell$position < - destination
cell
})
private$position_from_rank()
}, delete_cell = function(cell) {
if (is.null(self$cells[[cell$id]])) return()
if (!is.null(self$cells[[cell$id]]$name)) {
self$run_in_env(paste0("rm(", self$cells[[cell$id]]$name,
")"))
self$run_in_env(paste0("rm(", self$cells[[cell$id]]$name,
"_saved)"))
}
position < - self$cells[[cell$id]]$position
self$cells[[cell$id]] < - NULL
self$cells < - map(self$cells, function(cell) {
if (cell$position > position) cell$position < - cell$position -
1
cell
})
if (cell$id %in% names(V(private$graph))) {
private$graph < - delete_vertices(private$graph, V(private$graph)[[cell$id]])
}
}, run_all = function() {
topo < - topo_sort(private$graph, mode = "in")
for (cell in self$cells[topo]) {
self$run_cell(cell, update = FALSE)
}
}, run_cell = function(cell, update = TRUE, capturePlots = TRUE) {
private$callstack = c()
if (capturePlots == TRUE) {
while (dev.cur() > 1) dev.off()
ggplot2:::.store$set(NULL)
svgPath < - paste0(file.path(self$static_dir, cell$id),
".svg")
svg(filename = svgPath)
dev.control(displaylist = "enable")
}
name < - NULL
if (str_detect(cell$value, "^.+ < -")) {
name < - str_match(cell$value, "^(.+?) ? < -")[, 2]
modified_cell < - str_replace(cell$value, paste0("^",
name), paste0(name, "_saved"))
self$run_in_env(private$wrap(name))
res < - self$run_in_env(modified_cell)
} else {
res < - eval(parse(text = cell$value), private$env)
}
if ("htmlwidget" %in% class(res)) {
htmlPath = paste0(file.path(self$static_dir, cell$id),
".html")
htmlwidgets::saveWidget(res, htmlPath, selfcontained = TRUE)
}
hasImage = FALSE
if (capturePlots == TRUE) {
p < - recordPlot()
p2 < - last_plot()
dev.off()
if (!is.null(p2)) {
ggsave(svgPath)
}
hasImage = !is.null(p[[1]]) || !is.null(p2)
}
pos < - unname(cell$position)
if (is.null(pos) && length(self$cells) > 0) {
positions < - sapply(self$cells, `[[`, "position")
pos < - max(positions) + 1
} else if (is.null(pos)) {
pos < - 1
}
self$cells < - map(self$cells, function(cell) {
if (cell$position >= pos) cell$position < - cell$position +
1
cell
})
if (!is.null(self$cells[[cell$id]]) && !is.null(self$cells[[cell$id]]$name) &&
!is.null(name) && self$cells[[cell$id]]$name != name) {
self$run_in_env(paste0("rm(", self$cells[[cell$id]]$name,
")"))
self$run_in_env(paste0("rm(", self$cells[[cell$id]]$name,
"_saved)"))
}
self$cells[[cell$id]] = list(id = cell$id, value = cell$value,
position = unname(pos), hasImage = hasImage, name = name,
result = res, viewWidth = cell$viewWidth, viewHeight = cell$viewHeight,
open = ifelse(is.null(cell$open), FALSE, cell$open))
private$position_from_rank()
if (!is.null(name)) {
private$name_to_id[name] = cell$id
}
if (!(cell$id %in% names(V(private$graph)))) {
private$graph < - add_vertices(private$graph, 1, name = cell$id)
}
for (call in private$callstack) {
call_id < - private$name_to_id[call]
if (!are.connected(private$graph, cell$id, call_id)) {
private$graph < - add_edges(private$graph, c(cell$id,
call_id))
}
}
if (is.null(res)) res < - ""
updates = c(cell$id)
if (update == TRUE) {
updates < - c(updates, self$propagate_updates(cell,
capturePlots = capturePlots))
}
updates
}, update_from_view = function(cell, value, capturePlots = TRUE) {
if (!is.null(cell$name) && cell$name != "") {
self$run_in_env(str_c(cell$name, "_saved[1] = ",
value))
}
updates < - self$propagate_updates(cell, capturePlots = capturePlots)
updates
}, update_size = function(cell, value) {
if (!is.null(value$width)) {
self$cells[[cell$id]]$viewWidth = c(value$width)
}
if (!is.null(value$height)) {
self$cells[[cell$id]]$viewHeight = c(value$height)
}
}, update_open = function(cell, value) {
if (!is.null(value$open)) {
self$cells[[cell$id]]$open < - value$open
}
}, propagate_updates = function(cell, capturePlots = TRUE) {
updates < - c()
ego_graph < - make_ego_graph(self$get_graph(), order = 1000,
nodes = cell$id, mindist = 0, mode = "in")[[1]]
dependencies < - names(topo_sort(ego_graph, mode = "in")[-1])
for (dependency in dependencies) {
updates < - c(updates, self$run_cell(self$cells[[dependency]],
update = FALSE, capturePlots = capturePlots))
}
updates
}, data_frame = function() {
reformat_nulls < - function(x) lapply(x, function(y) ifelse(is.null(y),
"", y))
bind_rows(lapply(lapply(self$cells, "[", c("id", "value",
"position", "hasImage", "viewWidth", "viewHeight")),
reformat_nulls)) %>% arrange(position)
}, get_graph = function() {
return(private$graph)
}, print = function() {
cat(paste0("Reactor notebook with ", length(self$cells),
" cell", ifelse(length(self$cells) == 1, "", "s"),
"\n"), sep = "")
for (cell in self$cells) {
cat(cell$value, "\n", sep = "")
}
}, save = function(file, rds = FALSE) {
if (rds == TRUE) {
contents_to_save < - list(graph = private$graph, cells = self$cells,
name_to_id = private$name_to_id, static_dir = self$static_dir)
saveRDS(contents_to_save, file)
} else {
topo < - topo_sort(private$graph, mode = "in")
chunks < - lapply(self$cells[topo], private$cell_to_chunk)
header < - glue::glue("\n ```{{r setup, include=FALSE}}\n # This is a [Reactor](https://github.com/herbps10/reactor) notebook. Here's how to run this notebook in Reactor: \n\n # ```\n # library(reactor)\n # \n # notebook < - ReactorNotebook$load('{basename(file)}')\n # start_reactor(notebook)\n # ```\n \n library(reactor)\n ```\n \n \n ")
footer < - "\n"
txt < - str_c(header, str_c(unlist(chunks), collapse = "\n\n"),
footer)
cat(txt, file = file)
}
}, load_ = function(file) {
if (tolower(tools::file_ext(file)) == "rds") {
contents < - readRDS(file)
private$graph < - contents$graph
self$cells < - contents$cells
private$name_to_id < - contents$name_to_id
self$static_dir < - contents$static_dir
if (!file.exists(self$static_dir)) self$static_dir < - tempdir()
self$run_all()
} else {
knit_code$restore()
md_pattern < - all_patterns[["md"]]
knit_patterns$set(md_pattern)
lines < - readLines(file)
knitr:::split_file(lines)
chunks < - knitr:::knit_code$get()
cells < - lapply(chunks, private$chunk_to_cell)
cells < - Filter(function(cell) cell$id != "setup",
cells)
lapply(cells, self$run_cell, update = FALSE)
}
}, export = function() {
topo < - topo_sort(private$graph, mode = "in")
res < - stringr::str_c(lapply(self$cells[topo], `[[`,
"value"), collapse = "\n\n")
res
}, export_shiny = function() {
}), private = list(env = NULL, callstack = c(), name_to_id = c(),
graph = graph.empty(directed = TRUE), wrap = function(name) {
paste0(name, " % < a-% {\n private$callstack < - c(private$callstack, '",
name, "')\n get('", name, "_saved', private$env)\n }\n ")
}, position_from_rank = function() {
cell_ranks < - rank(unlist(lapply(self$cells, "[", "position")))
i < - 1
for (id in names(self$cells)) {
self$cells[[id]]$position < - unname(cell_ranks[i])
i < - i + 1
}
cell_ranks
}, cell_to_chunk = function(cell) {
props < - list(position = cell$position, open = cell$open,
hasImage = cell$hasImage, viewWidth = cell$viewWidth,
viewHeight = cell$viewHeight, echo = TRUE)
if ("md" %in% class(cell$result)) {
props$results < - "'asis'"
props$echo < - FALSE
}
private$make_chunk(cell$id, cell$value, props)
}, make_chunk = function(id, value, props) {
props < - props[!unlist(map(props, is.null))]
prop_string < - str_c(names(props), "=", props, collapse = ", ")
glue("```{{r {id}, {prop_string}}}\n{value}\n```")
}, chunk_to_cell = function(chunk) {
attr(chunk, "chunk_opts")$label < - str_replace(attr(chunk,
"chunk_opts")$label, "^r ", "")
c(list(id = attr(chunk, "chunk_opts")$label, value = str_c(as.vector(chunk),
collapse = "\n")), attributes(chunk)$chunk_opts)
}))
