# Copyright (C) President and Fellows of Harvard College and
# Trustees of Mount Holyoke College, 2014, 2015, 2016, 2017, 2018.
# This program is free software: you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this program. If not, see
# <http://www.gnu.org/licenses/>.
###################### Annotation.R ########################
# This file contains functions that are called within annotations
# that are added to collect provenance within functions and
# control constructs.
#
# It also contains helper functions that are used only for
# annotations internal to functions and control constructs.
#--------------------USER FUNCTIONS-----------------------#
#' .ddg.function creates a procedure node of type Operation for
#' procedures implemented as functions in the original R script.
#' The function name and input parameters are obtained automatically
#' from the calling environment. The outs parameters may be used
#' optionally to create output data nodes. These MUST be passed as
#' a list of strings, not names, unless the value is a file name.
#' Users can right-click on the procedure node in DDG Explorer to
#' see the code for the function in the original script. For more
#' details on outs parameters, see .ddg.create.output.nodes.
#' The outs parameters should be a list of names of data nodes to be created as
#' outputs to this procedure node. These MUST be passed as
#' a list of strings, not names, unless the value is a file name
#' (internal use only)
#'
#' @param outs.graphic (optional) the name of a snapshot node to be used as a
#' file name. A graphical snapshot is simply a captured image
#' of the graphic device active at the time of the call to
#' .ddg.function or .ddg.procedure.
#' @param outs.data (optional) a list of names of data nodes.
#' @param outs.exception (optional) a list of names of exception nodes.
#' @param outs.url (optional) a list of names of url nodes.
#' @param outs.file (optional) a list of names of file nodes. Supported file
#' extensions include: .csv, .jpg, .jpeg, .pdf, and .txt.
#' @param graphic.fext (optional) the file extension for a graphics file, defaults to jpeg.
#' @return nothing
#' @noRd
.ddg.function <- function(outs.graphic=NULL, outs.data=NULL,
outs.exception=NULL, outs.url=NULL, outs.file=NULL,
graphic.fext="jpeg") {
#print("In .ddg.function")
if (!.ddg.is.init()) return(invisible())
.ddg.inc("ddg.func.depth")
pname <- NULL
.ddg.lookup.function.name(pname)
# Look up input parameters from calling environment.
call <- sys.call(-1)
# Try to find the full call so that we can bind the parameters
# by name in the DDG. In the case that the function being executed
# has been passed as a parameter to another function and is being
# called from the context (for example, with lapply and other higher-order
# functions), the match.call will fail. In that case, we will use the
# call as it appears in side the higher-order function.
full.call <- tryCatch (match.call(sys.function(-1), call=call),
error = function(e) call)
# Create start node for the calling statement if one is not already created.
.ddg.create.start.for.cur.cmd (call)
.ddg.create.function.nodes(pname, call, full.call, outs.graphic, outs.data,
outs.exception, outs.url, outs.file, graphic.fext,
env = sys.frame(.ddg.get.frame.number(sys.calls())))
invisible()
}
#' .ddg.return.value creates a data node for a function's return value. If
#' the function is called from a console command and console mode is
#' enabled, a data flow edge will be created linking this node to
#' the console command that uses the value. .ddg.return.value returns the
#' same value as the function (expr) and can be used in place of the
#' function's normal return statement(s) if it is the last statement
#' in the function. Otherwise, it should be a parameter to return,
#' as in return(.ddg.return.value(expr)). If expr is an assignment, nodes
#' and edges are created for the assignment (internal use only)
#'
#' @param expr the value returned by the function.
#' @param cmd.func the DDGStatement object for the return statement
#' @return the value that the function whose return value we are capturing
#' returns
#' @noRd
.ddg.return.value <- function (expr=NULL, cmd.func=NULL) {
if (!.ddg.is.init()) return(expr)
#print("In .ddg.return.value")
parsed.stmt <- NULL
if (!is.null(cmd.func)) {
parsed.stmt <- cmd.func()
}
# If expr is an assignment, create nodes and edges for the assignment.
orig.expr <- substitute(expr)
#print(paste(".ddg.return.value: expr =", paste(deparse(orig.expr),
# collapse="\n")))
frame.num <- .ddg.get.frame.number(sys.calls())
env <- sys.frame(frame.num)
orig.return <- paste("return(", deparse(orig.expr), ")", sep="")
pname <- NULL
.ddg.lookup.function.name(pname)
#print(paste(".ddg.return.value: pname =", pname))
# If this is a recursive call to .ddg.return.value, find
# the caller of the first .ddg.return.value
if (grepl("^ddg|^.ddg|^prov", pname)) {
#print(".ddg.return.value: Found a recursive call")
caller.frame <- .ddg.find.ddg.return.value.caller.frame.number ()
pname <- as.character(sys.call(caller.frame)[[1]])
#print(paste(".ddg.return.value: updated pname =", pname))
}
else {
#print(".ddg.return.value: NOT a recursive call")
caller.frame <- -1
}
# Prints the call & arguments.
# expr forces evaluation of the function early. I think that
# causes some examples to work with debugging on but not off.
# Checking. (6/26/2015 - Barb).
# Yes, ReturnTest.R fails on the recursive f5 function
#print(paste(".ddg.return.value:", sys.call(caller.frame))) #, "returns",
# expr))
# If this is not a recursive call to .ddg.return.value and
# .ddg.function was not called, create the function nodes that
# it would have created.
call <- sys.call(caller.frame)
if (!.ddg.proc.node.exists(pname)) {
#print(".ddg.return.value creating function nodes")
full.call <- match.call(sys.function(caller.frame), call=call)
.ddg.create.function.nodes(pname, call, full.call,
env = sys.frame(.ddg.get.frame.number(sys.calls()))
)
}
else {
#print(".ddg.return.value decrementing func.depth")
.ddg.dec ("ddg.func.depth")
}
if (is.null(cmd.func)) {
#print(".ddg.return.value constructing DDG statement for the return call")
return.stmt <- .ddg.construct.DDGStatement (parse(text=orig.return),
pos=NA, script.num=NA)
}
else {
#print(".ddg.return.value using existing DDG statement for the return call")
return.stmt <- cmd.func()
}
# Create a data node for the return value. We want the scope of
# the function that called the function that called ddg.return.
call.text <- gsub(" ", "", deparse(call, nlines=1))
return.node.name <- paste(call.text, "return")
#print(paste(".ddg.return.value: sys.nframe =", sys.nframe()))
#print(paste(".ddg.return.value: caller.frame =", caller.frame))
return.node.scope <-
environmentName (if (sys.nframe() == 2) .GlobalEnv
else parent.env(sys.frame(caller.frame)))
#print(paste(".ddg.return.value: return.node.scope =", return.node.scope))
.ddg.save.data(return.node.name, expr, scope=return.node.scope)
# Check if there is a return call within this call to ddg.return.
if (.ddg.has.call.to(parsed.stmt, "return")) {
.ddg.proc.node("Operation", return.stmt@abbrev, return.stmt@abbrev, cmd=return.stmt)
# Create control flow edge from preceding procedure node.
.ddg.proc2proc()
# Create an edge from the return statement to its return value.
.ddg.proc2data(return.stmt@abbrev, return.node.name, return.node.scope,
return.value=TRUE)
}
else {
.ddg.lastproc2data(return.node.name, dscope=return.node.scope)
}
.ddg.add.to.return.values (call.text)
# If it does not have return, then its parameter was a call to .ddg.eval
# and this stuff has been done already.
if (.ddg.has.call.to(parsed.stmt, "return")) {
# Create edges from variables used in the return statement
vars.used <- return.stmt@vars.used
for (var in vars.used) {
# Make sure there is a node we could connect to.
scope <- .ddg.get.scope(var)
if (.ddg.data.node.exists(var, scope)) {
.ddg.data2proc(var, scope, return.stmt@abbrev)
}
}
for (var in return.stmt@vars.set)
{
if (var != "")
{
# Create output data node.
dvalue <- eval(as.symbol(var), envir=env)
# Check for non-local assignment
if ( .ddg.is.nonlocal.assign(return.stmt@parsed[[1]]) )
{
env <- .ddg.where(var, env = parent.env(parent.frame()), warning = FALSE)
if ( identical(env, "undefined") )
env <- globalenv()
}
dscope <- .ddg.get.scope(var, env=env)
.ddg.save.data(var, dvalue, scope=dscope)
# Create an edge from procedure node to data node.
.ddg.proc2data(return.stmt@abbrev, var, dscope=dscope, return.value=FALSE)
}
}
# Create nodes and edges dealing with reading and writing files
.ddg.create.file.read.nodes.and.edges()
.ddg.create.file.write.nodes.and.edges ()
.ddg.create.graphics.nodes.and.edges ()
}
# Create the finish node for the function
#print(".ddg.return.value: creating finish node")
.ddg.add.finish.node()
#print(paste (".ddg.return.value: returning", expr))
return(expr)
}
#' .ddg.find.ddg.return.value.caller.frame.number returns the frame
#' number of the first caller to .ddg.return.value. If .ddg.return.value
#' is called recursively, this will give us the position of the
#' earliest one called.
#'
#' @return the frame number of the user function that called .ddg.return.value
#' @noRd
.ddg.find.ddg.return.value.caller.frame.number <- function() {
# Get the stack
calls <- sys.calls()
# Find the calls to .ddg.return.value
ddg.funcs <- unlist(lapply (calls,
function (call) return (grepl("^ddg|^.ddg|^prov", deparse(call)[[1]]))))
calls.to.ddg.return.value <- unlist(lapply(calls,
function (call)
return(.ddg.is.call.to(call, as.name(".ddg.return.value")))))
non.ddg.calls.to.ddg.return.value <- !(ddg.funcs[1:length(ddg.funcs)-1]) &
calls.to.ddg.return.value[2:length(calls.to.ddg.return.value)]
which.frame <- Position (function (call) return (call),
non.ddg.calls.to.ddg.return.value, right=TRUE)
# Return the frame number of the caller to .ddg.return.value
return (which.frame)
}
#' .ddg.annotate.inside returns True if we should be annotating inside
#' control constructs
#' @return true if annotating inside control constructs
#' @noRd
.ddg.annotate.inside <- function() {
return(.ddg.get("ddg.annotate.inside"))
}
#' .ddg.details.omitted inserts an operational node called "Details Omitted"
#' in cases where not all iterations of a loop are annotated. This may
#' happen if the number of the first loop to be annotaed (first.loop) is
#' greater than 1 and/or if the total number of loops to be annotated is
#' less than the actual number of iterations.
#' It also sets a variable to remember that the last construct is incomplete
#' so that the right data nodes get created.
#' NOTE: This might be useful outside of the context of loops, but is
#' currently only used within loops (internal use only)
#'
#' @return nothing
#' @noRd
.ddg.details.omitted <- function() {
pnode.name <- "Details Omitted"
.ddg.proc.node("Incomplete", pnode.name, pnode.name)
.ddg.proc2proc()
.ddg.set.details.omitted(TRUE)
if (.ddg.debug.lib()) {
print("Adding Details Omitted node")
}
}
#' .ddg.should.run.annotated returns True if we should run the annotated
#' version of a function (internal use only)
#' @param func.name name of function
#' @return True if we should run annotated version
#' @noRd
.ddg.should.run.annotated <- function (func.name) {
# Check if we are in a loop and loop annotations are off
if (!.ddg.loop.annotate() && .ddg.inside.loop() > 0) return (FALSE)
# Make sure this specific function has not been disabled
if (!is.null(.ddg.annotate.off()) & func.name %in% .ddg.annotate.off()) return(FALSE)
# Not annotating functions in general
# Check if this specific function should be annotated
if (!is.null(.ddg.annotate.on()) & func.name %in% .ddg.annotate.on()) return(TRUE)
# If we do not know anything specific about this function, follow the
# general rule
return (.ddg.annotate.inside())
}
#' .ddg.eval evaluates a statement and creates data flow edges from
#' variable and function return nodes that are used in the
#' statement. If the statement is an assignment statement, it also
#' creates a data node for the variable assigned and a corresponding
#' data flow edge. If .ddg.eval is called from inside a function, cmd.func
#' is a function that returns the corresponding DDGStatement object.
#' If .ddg.eval is called from inside a control block, cmd.func is an
#' integer that points to the corresponding DDGStatement object stored
#' in the list .ddg.statements (internal use only)
#'
#' @param statement a string version of the statement to evaluate.
#' @param cmd.func the corresponding DDGStatement if inside a function,
#' or an integer identifying the position of the statement in a list
#' if inside a control construct
#' @noRd
.ddg.eval <- function(statement, cmd.func=NULL) {
# Statement at top level.
if (is.null(cmd.func)) {
parsed.statement <- parse(text=statement)
cmd <- NULL
}
# Statement inside control block.
else if (is.numeric(cmd.func)) {
num <- cmd.func
cmd <- .ddg.statement(num)
parsed.statement <- cmd@parsed
}
# Statement inside function.
else {
cmd <- cmd.func()
parsed.statement <- cmd@parsed
}
if (.ddg.debug.lib()) print (paste(".ddg.eval: statement =", statement))
frame.num <- .ddg.get.frame.number(sys.calls())
env <- sys.frame(frame.num)
if (!.ddg.is.init()) {
return(eval(parsed.statement, env))
}
# If break statement, create procedure node and close open start nodes.
if (!is.null(cmd) && cmd@text == "break") {
.ddg.break.statement()
}
# If next statement, create procedure node and close open start nodes.
if (!is.null(cmd) && cmd@text == "next") {
.ddg.next.statement()
}
return.value <- .ddg.parse.commands(parsed.statement, environ=env,
run.commands = TRUE,
called.from.ddg.eval=TRUE,
cmds=list(cmd))
if (.ddg.get("ddg.func.depth")) {
if (!is.null(cmd)) {
.ddg.link.function.returns(cmd)
}
}
return (return.value)
}
#' .ddg.start creates a procedure node of type Start called pname.
#' In DDG Explorer, the section of the provenance graph between
#' matching Start and Finish nodes can be expanded and collapsed.
#' Users can also right-click on a Start or Finish node to see the
#' intervening code in the original script.
#' @param pname the label for the node. This can be passed as
#' a string or as a name.
#' @return nothing
#' @noRd
.ddg.start <- function(pname=NULL) {
if (!.ddg.is.init()) return(invisible())
.ddg.lookup.function.name(pname)
# Check for NULL.
if (is.null(pname)) {
msg <- "Cannot call .ddg.start with NULL value from top-level."
.ddg.insert.error.message(msg)
return
}
# Create start node for the calling statement if one is not already created.
frame.number <- .ddg.get.frame.number(sys.calls())
env <- sys.frame(frame.number)
.ddg.create.start.for.cur.cmd (env)
# Create start non-operational step.
.ddg.proc.node("Start", pname, pname)
# Create control flow edge from preceding procedure node.
.ddg.proc2proc()
}
#' .ddg.finish creates a procedure node of type Finish called pname.
#' In DDG Explorer, the section of the provenance graph between
#' matching Start and Finish nodes can be expanded and collapsed.
#' Users can also right-click on a Start or Finish node to see the
#' intervening code in the original script.
#' @param pname the label for the node. This can be passed as
#' a string or as a name.
#' @return nothing
#' @noRd
.ddg.finish <- function(pname=NULL) {
if (!.ddg.is.init()) return(invisible())
.ddg.lookup.function.name(pname)
# Check for NULL.
if (is.null(pname)) {
msg <- "Cannot call .ddg.finish with NULL value from top-level."
.ddg.insert.error.message (msg)
}
# Create finish non-operational step.
.ddg.proc.node("Finish", pname, pname)
# Create control flow edge from preceding procedure node.
.ddg.proc2proc()
# .ddg.finish is added to the end of blocks. We want the block to
# return the value of the last R statement.
return(.ddg.get ("ddg.last.R.value"))
}
#' Controlling Provenance Detail
#'
#' prov.annotate.on enables provenance collection for specific functions.
#'
#' To allow provenance to be collected inside functions initially, the
#' user calls prov.init or prov.run with TRUE for the annotate.inside.functions
#' parameter. This results in provenance being collected inside all functions.
#'
#' To get finer control over which functions are annotated, the user can
#' call prov.annotate.on and prov.annotate.off. In prov.annotate.on, the user passes in
#' a list of function names that should be annotated. Functions not listed
#' are not annotated. If the user passes in NULL, all functions are annotated.
#'
#' prov.annotate.on can be called multiple times. Each call adds more names
#' to the list of annotated functions, continuing to annotate the previous
#' functions in the list.
#'
#' In prov.annotate.off, the user passes in
#' a list of function names that should not be annotated. Functions not listed
#' are not annotated. If the user passes in NULL, all functions are annotated.
#'
#' prov.annotate.off can be called multiple times. Each call adds more names
#' to the list of unannotated functions.
#'
#' The level of detail of provenance can be set using the annotate.inside.functions,
#' max.loops and snapshot.size parameters of prov.run and prov.init.
#' It can also be set using prov.set.detail, which will impact the
#' future executions of prov.run and prov.init. The detail level can
#' take on the following values:\cr
#' 0 = no internal provenance, no snapshots (the prov.init and prov.run defaults).\cr
#' 1 = provenance inside functions and if-statements and 1 iteration of each loop, snapshots limited to 10k each.\cr
#' 2 = provenance inside functions and if-statements and up to 10 iterations of each loop, snapshots limited to 100k each.\cr
#' 3 = provenance inside functions and if-statements and all iterations of each loop, complete snapshots.
#'
#' @param fnames.on a list of one or more function names passed in as strings.
#' @export
#' @rdname prov.annotate.on
prov.annotate.on <- function (fnames.on=NULL){
if (is.null(fnames.on)) {
.ddg.set("ddg.annotate.off", vector())
.ddg.set("ddg.annotate.inside", TRUE)
return()
}
# Add to the on list
on.list <- .ddg.get("ddg.annotate.on")
on.list <- union (on.list, fnames.on)
.ddg.set("ddg.annotate.on", on.list)
# Remove from the off list
off.list <- .ddg.annotate.off()
off.list <- Filter (function(off) !(off %in% fnames.on), off.list)
.ddg.set("ddg.annotate.off", off.list)
}
#' prov.annotate.off disables provenance collection for specified functions.
#'
#' @param fnames.off a list of one or more function names passed in as strings.
#' @export
#' @rdname prov.annotate.on
#' @seealso \code{\link{prov.init}} and \code{\link{prov.run}}
#' @examples
#' prov.set.detail(1)
#' prov.init()
#' prov.annotate.on("f")
#' prov.annotate.off("g")
#' f <- function (x) {
#' if (x < 0) return (0)
#' else return (x - 1)
#' }
#' g <- function (x) {
#' return (x - 1)
#' }
#' f (3)
#' g (-3)
#' prov.quit()
prov.annotate.off <- function (fnames.off=NULL) {
if (is.null(fnames.off)) {
.ddg.set("ddg.annotate.on", vector())
.ddg.set("ddg.annotate.inside", FALSE)
return()
}
# Add to the off list
off.list <- .ddg.annotate.off()
off.list <- union (off.list, fnames.off)
.ddg.set("ddg.annotate.off", off.list)
# Remove from the on list
on.list <- .ddg.annotate.on()
on.list <- Filter (function(on) !(on %in% fnames.off), on.list)
.ddg.set("ddg.annotate.on", on.list)
}
#' .ddg.save.annotated.script saves a copy of the annotated script to
#' the debug directory.
#' @param cmds set of parsed commands
#' @param script.name name of script
#' @return nothing
#' @noRd
.ddg.save.annotated.script <- function(cmds, script.name) {
for (i in 1:length(cmds)) {
expr <- cmds[[i]]@annotated
for (j in 1:length(expr)) {
line <- deparse(expr[[j]])
if (i == 1 && j == 1) script <- line else script <- append(script, line)
}
}
fileout <- file(paste(.ddg.path.debug(), "/", "annotated-", script.name, sep=""))
write(script, fileout)
close(fileout)
}
#' .ddg.add.annotations accepts a DDGStatement and returns an expression.
#' The returned expression is annotated as needed.
#' @param command a DDGStatement
#' @return an expression with annotations
#' @noRd
.ddg.add.annotations <- function(command) {
#print("In .ddg.add.annotations")
#print(paste("command@text =", command@text))
parsed.command <- command@parsed[[1]]
# Return if statement is empty.
if (length(parsed.command) == 0) return(command@parsed)
# Replace source with .ddg.source.
if (is.call(parsed.command) && parsed.command[[1]] == "source") {
return(.ddg.add.ddg.source(parsed.command, command))
}
# Annotate user-defined functions.
# Note that this will not annotate anonymous functions, like ones that might
# be passed to lapply, for example. Is that what we want?
if (.ddg.is.assign(parsed.command) && .ddg.is.functiondecl(parsed.command[[3]])) {
return(.ddg.add.function.annotations(command))
}
statement.type <- .ddg.get.statement.type(parsed.command)
loop.types <- list("for", "while", "repeat")
# Move into funcs below && .ddg.max.loops() > 0) {
if (length(statement.type > 0) && !is.null(statement.type)) {
# Annotate if statement.
if (statement.type == "if"){
return(.ddg.annotate.if.statement(command))
}
# Annotate for, while, repeat statement.
else if (statement.type %in% loop.types) {
return(.ddg.annotate.loop.statement(command, statement.type))
}
# Annotate simple block.
else if (statement.type == "{") {
return(.ddg.annotate.simple.block(command))
}
}
# Not a function or control construct. No annotation required.
return(command@parsed)
}
#' .ddg.add.ddg.source replaces source with .ddg.source.
#' @param parsed.command a parsed expression that is a call to the source function.
#' @param command the DDGStatement object for the source call
#' @return a parsed expression with source replaced by .ddg.source
#' @noRd
.ddg.add.ddg.source <- function(parsed.command, cmd) {
script.name <- deparse(parsed.command[[2]])
parsed.command.txt <- paste(".ddg.source(", script.name,
", calling.script =", cmd@script.num,
", startLine=", cmd@pos@startLine,
", startCol=", cmd@pos@startCol,
", endLine=", cmd@pos@endLine,
",endCol=", cmd@pos@endCol, ")", sep="")
return(parse(text=parsed.command.txt))
}
#' .ddg.add.function.annotations is passed a command that corresponds
#' to a function declaration. It returns a parsed command corresponding
#' to the same function declaration but with calls to .ddg.function,
#' .ddg.eval and .ddg.return.value inserted if they are not already present.
#' The functions prov.annotate.on and prov.annotate.off may be used to provide
#' a list of functions to annotate or not to annotate, respectively.
#' @param function.decl a command that contains an assignment statement where the value
#' being bound is a function declaration
#' @return a parsed command with annotations added
#' @noRd
.ddg.add.function.annotations <- function(function.decl) {
#print("In .ddg.add.function.annotations")
parsed.function.decl <- function.decl@parsed[[1]]
# Get function name.
func.name <- toString(parsed.function.decl[[2]])
#print(paste("Annotating", func.name))
# Get function definition.
func.definition <- parsed.function.decl[[3]]
# Create function block if necessary.
if (func.definition[[3]][[1]] != "{") {
func.definition <- .ddg.create.function.block(func.definition)
}
# Create new function body with an if-then statement for annotations.
func.definition <- .ddg.add.conditional.statement(func.definition, func.name)
# Insert call to .ddg.function if not already added.
if (!.ddg.has.call.to(func.definition[[3]], ".ddg.function")) {
func.definition <- .ddg.insert.ddg.function(func.definition)
}
# Insert calls to .ddg.return.value if not already added.
if (!.ddg.has.call.to(func.definition[[3]], ".ddg.return.value")) {
func.definition <- .ddg.wrap.all.return.parameters(func.definition,
function.decl@contained)
}
# Wrap last statement with .ddg.return.value if not already added
# and if last statement is not a simple return or a ddg function.
last.statement <- .ddg.find.last.statement(func.definition)
if (!.ddg.is.call.to(last.statement, ".ddg.return.value") &
!.ddg.is.call.to(last.statement, "return") &
!.ddg.is.call.to.ddg.function(last.statement)) {
func.definition <- .ddg.wrap.last.line(func.definition, function.decl@contained)
}
# Wrap statements with .ddg.eval if not already added and if
# statements are not calls to a ddg function and do not contain
# .ddg.return.value.
if (!.ddg.has.call.to(func.definition, ".ddg.eval")) {
func.definition <- .ddg.wrap.with.ddg.eval(func.definition, function.decl@contained)
}
# Reassemble parsed.command.
#print(paste("Done annotating", func.name))
return (as.expression (call ("<-", as.name(func.name), func.definition)))
}
#' .ddg.create.function.block creates a function block.
#' @param func.definition a parsed expression for a function declaration (not
#' the full assignment statement in which it is declared)
#' @return a parse tree for the same function declaration but with
#' the function statements inside a block.
#' @noRd
.ddg.create.function.block <- function(func.definition) {
# Get the function parameters.
func.params <- func.definition[[2]]
# Get the body of the function.
func.body <- func.definition[[3]]
# Add block and reconstruct the call.
new.func.body <- call("{", func.body)
return(call("function", func.params, as.call(new.func.body)))
}
#' .ddg.add.conditional.statement creates a new function definition
#' containing an if-then statement used to control annotation.
#' @param func.definition the original function definition.
#' @return the function definition with annotations added
#' @noRd
.ddg.add.conditional.statement <- function(func.definition, func.name) {
# Get the function parameters.
func.params <- func.definition[[2]]
# Get the body of the function.
func.body <- func.definition[[3]]
pos <- length(func.body)
# Create new function definition containing if-then statement.
# This will prevent us from collecting provenance inside
# functions that are inside control structures when we
# are not collecting provenance in control structures.
new.func.body.txt <-
c(paste("if (.ddg.should.run.annotated(\"", func.name, "\")) {", sep=""),
as.list(func.body[2:pos]),
paste("} else {", sep=""),
as.list(func.body[2:pos]),
paste("}", sep=""))
new.func.expr <- parse(text=new.func.body.txt)
new.func.body <- new.func.expr[[1]]
return(call("function", func.params, call("{", new.func.body)))
}
#' .ddg.insert.ddg.function inserts .ddg.function before the first line
#' in the annotated block of a function body.
#' @param func.definition a parsed expression for a function declaration (not
#' the full assignment statement in which it is declared)
#' @return a parse tree for the same function declaration but with
#' a call to .ddg.function as the first statement.
#' @noRd
.ddg.insert.ddg.function <- function(func.definition) {
# Get the function parameters.
func.params <- func.definition[[2]]
# Get the body of the function.
func.body <- func.definition[[3]]
# Get annotated block.
block <- func.body[[2]][[3]]
pos <- length(block)
# Insert .ddg.function.
inserted.statement <- call(".ddg.function")
new.statements.txt <- c(as.list("{"), inserted.statement,
as.list(block[2:pos]), as.list("}"))
block <- parse(text=new.statements.txt)[[1]]
func.body[[2]][[3]] <- block
return(call("function", func.params, as.call(func.body)))
}
#' .ddg.wrap.return.parameters wraps parameters of return functions
#' with .ddg.return.value in the annotated block of a function body.
#'
#' @param block the parse tree corresponding to the statements within
#' the annotated block of a function
#' @param parsed.stmts the list of DDGStatement objects contained in the
#' function
#' @return a parse tree for the same function body but with
#' a call to .ddg.return.value wrapped around all expressions that are
#' returned.
#' @noRd
.ddg.wrap.return.parameters <- function(block, parsed.stmts) {
# Check each statement in the annotated block to see if it
# contains a return.
pos <- length(block)
#print(paste(".ddg.wrap.return.parameters: pos =", pos))
for (i in 1:pos) {
statement <- block[[i]]
#print(paste("statement", i, "=", deparse(statement)))
#print(paste("parsed.stmts", i, "=", parsed.stmts[[i]]@abbrev))
if (.ddg.has.call.to(statement, "return")) {
#print(".ddg.wrap.return.parameters: found return call")
# If statement is a return, wrap parameters with .ddg.return.value.
if (.ddg.is.call.to(statement, "return")) {
#print(".ddg.wrap.return.parameters: IS a return call")
# Need to handle empty parameter separately.
if (length(statement) == 1) {
ret.params <- ""
} else {
ret.params <- statement[[2]]
}
#print(paste(".ddg.wrap.return.parameters: ret.params =", ret.params))
#for (i in 1:length(parsed.stmts)) {
# print(paste(".ddg.wrap.return.parameters: parsed.stmts =",
# parsed.stmts[[i]]@abbrev))
#}
if (is.list(parsed.stmts)) {
#print(".ddg.wrap.return.parameters: parsed.stmts is a list")
#print(paste("str(parsed.stmts) =", str(parsed.stmts)))
parsed.stmt <- parsed.stmts[[i-2]]
}
else {
#print(".ddg.wrap.return.parameters: parsed.stmts is NOT a list")
#print(paste("str(parsed.stmts) =", str(parsed.stmts)))
parsed.stmt <- parsed.stmts
}
#print(paste(".ddg.wrap.return.parameters: parsed.stmt =", parsed.stmt@abbrev))
# If parameters contain a return, recurse on parameters.
if (.ddg.has.call.to(ret.params, "return")) {
ret.params <- .ddg.wrap.return.parameters(ret.params, parsed.stmt)
}
new.ret.params <- .ddg.create.ddg.return.call(ret.params, parsed.stmt)
new.statement <- call("return", new.ret.params)
block[[i]] <- new.statement
# If statement contains a return, recurse on statement.
} else {
#print(".ddg.wrap.return.parameters: CONTAINS a return call")
if (is.list(parsed.stmts)) {
#print(".ddg.wrap.return.parameters: parsed.stmts is a list")
#print(paste("str(parsed.stmts) =", str(parsed.stmts)))
#print(paste("@contained[[1]] =", parsed.stmts[[1]]@contained[[1]]@text))
parsed.stmt <- parsed.stmts[[i-2]]
}
else {
#print(".ddg.wrap.return.parameters: parsed.stmts is NOT a list")
#parsed.stmt <- parsed.stmts@contained[[i-2]]
parsed.stmt <- parsed.stmts
}
#print("Recursing")
#print(paste("Passing for parsed.stmt:", str(parsed.stmt)))
block[[i]] <- .ddg.wrap.return.parameters(statement, parsed.stmt)
#print("Returned from recursion")
}
}
#print(paste(".ddg.wrap.return.parameters: after annotation, block[[", i,
# "]] =", paste(deparse(block[[i]]), collapse="\n")))
}
return(block)
}
#' .ddg.wrap.all.return.parameters wraps parameters of all return
#' functions with .ddg.return.value in the annotated block of a function
#' definition.
#' @param func.definition a parsed expression for a function declaration (not
#' the full assignment statement in which it is declared)
#' @param parsed.stmts the list of DDGStatement objects contained in the
#' function
#' @return a parse tree for the same function declaration but with
#' a call to .ddg.return.value wrapped around all expressions that are
#' returned.
#' @noRd
.ddg.wrap.all.return.parameters <- function(func.definition, parsed.stmts) {
# Get function parameters.
func.params <- func.definition[[2]]
# Get the body of the function.
func.body <- func.definition[[3]]
# Get annotated block.
block <- func.body[[2]][[3]]
# Wrap individual return functions.
block <- .ddg.wrap.return.parameters(block, parsed.stmts)
# Get new function body
func.body[[2]][[3]] <- block
# Reconstruct function.
return(call("function", func.params, as.call(func.body)))
}
#' .ddg.find.last.statement finds the last statement in the annotated
#' block of a function.
#' @param func.definition a parsed expression for a function declaration (not
#' the full assignment statement in which it is declared)
#' @return the parse tree corresponding to the last statement in the
#' function definition.
#' @noRd
.ddg.find.last.statement <- function (func.definition) {
# Get function body.
func.body <- func.definition[[3]]
# Get annotated block.
block <- func.body[[2]][[3]]
pos <- length(block)
# Return final statement in block.
return(block[[pos]])
}
#' .ddg.wrap.last.line wraps the last line of the annotated block of a
#' function with .ddg.return.value.
#' @param func.definition a parsed expression for a function declaration (not
#' the full assignment statement in which it is declared)
#' @param parsed.stmts the list of DDGStatement objects contained in the
#' function
#' @return a parse tree for the same function declaration but with
#' a call to .ddg.return.value wrapped around the last line in the body.
#' @noRd
.ddg.wrap.last.line <- function(func.definition, parsed.stmts) {
# Get function parameters.
func.params <- func.definition[[2]]
# Get the body of the function.
func.body <- func.definition[[3]]
# Get annotated block.
block <- func.body[[2]][[3]]
pos <- length(block)
last.statement <- block[[pos]]
parsed.stmt <- parsed.stmts[[length(parsed.stmts)]]
wrapped.statement <- .ddg.create.ddg.return.call(last.statement, parsed.stmt)
func.body[[2]][[3]][[pos]] <- wrapped.statement
return(call("function", func.params, as.call(func.body)))
}
#' Creates a call to .ddg.return.value using a closure so that we
#' will be able to refer to the correct DDGStatement object when the
#' return call is executed.
#' @param last.statement the parse tree for the expression being returned
#' @param parsed.stmt the DDGStatement object corresponding to the last statement
#' @return a parse tree with a call to .ddg.return.value. The arguments to
#' .ddg.return.value are the parsed statement and the DDGStatement object.
#' @noRd
.ddg.create.ddg.return.call <- function (last.statement, parsed.stmt) {
# We need to force the evaluation of parsed.stmt for the closure to
# return the value that parsed.stmt has at the time the .ddg.eval
# call is created.
force(parsed.stmt)
#print(paste(".ddg.create.ddg.return.call: parsed.stmt =", parsed.stmt@abbrev))
#print(paste(".ddg.create.ddg.return.call: last.statement =", last.statement))
if (.ddg.has.call.to(last.statement, "return")) {
#print(".ddg.create.ddg.return.call: has call to return")
return (call (".ddg.return.value", last.statement, function() parsed.stmt))
}
else {
#print(".ddg.create.ddg.return.call: NO call to return")
# If there is no return call, we will use .ddg.eval to execute the
# statement and then .ddg.return.value to create the necessary return
# structure. We cannot use this technique if there is a return call
# because we if tried to eval a return call, we would end up returning
# from some code inside RDT, instead of the user's function.
new.statement <- .ddg.create.ddg.eval.call(last.statement, parsed.stmt)
return (call (".ddg.return.value", new.statement, function() parsed.stmt))
}
}
#' .ddg.wrap.with.ddg.eval wraps each statement in the annotated block
#' of a function body with .ddg.eval if the statement is not a call to a ddg
#' function and does not contain a call to .ddg.return.value. The statement
#' is enclosed in quotation marks.
#' @param func.definition a parsed expression for a function declaration (not
#' the full assignment statement in which it is declared)
#' @param parsed.stmts the list of DDGStatement objects contained in the
#' function
#' @return a parse tree for the same function declaration but with
#' the calls to .ddg.eval inserted.
#' @noRd
.ddg.wrap.with.ddg.eval <- function(func.definition, parsed.stmts) {
# Get the function parameters.
func.params <- func.definition[[2]]
# Get the body of the function.
func.body <- func.definition[[3]]
# Get annotated block.
block <- func.body[[2]][[3]]
pos <- length(block)
# Process each statement in block.
for (i in 2:pos) {
# Wrap with .ddg.eval if statement is not a call to a ddg function and
# does not contain a call to .ddg.return.value. Enclose statement in
# quotation marks.
statement <- block[[i]]
if (!grepl("^ddg", statement[1]) && !grepl("^.ddg", statement[1])
&& !grepl("^prov", statement[1])
&& !.ddg.has.call.to(statement, ".ddg.return.value")) {
parsed.stmt <- parsed.stmts[[i-2]]
new.statement <- .ddg.create.ddg.eval.call(statement, parsed.stmt)
func.body[[2]][[3]][[i]] <- new.statement
}
}
return(call("function", func.params, as.call(func.body)))
}
#' .ddg.annotate.if.statement adds annotations to if statements.
#' @param command original parsed command
#' @return parsed command with annotations added
#' @noRd
.ddg.annotate.if.statement <- function(command) {
#print(paste(".ddg.annotate.if.statement annotating", command@text))
if (.ddg.max.loops() == 0) {
parsed.command.txt <- deparse(command@parsed[[1]])
}
else {
# Get parsed command & contained statements
parsed.command <- command@parsed[[1]]
parsed.stmts <- command@contained
# Set initial values.
bnum <- 1
ptr <- 0
parent <- parsed.command
parsed.command.txt <- vector()
# If & else if blocks.
while (!is.symbol(parent) && parent[[1]] == "if") {
# Get block
block <- parent[[3]]
block <- .ddg.ensure.in.block(block)
# Get statements for this block.
block.stmts<- list ()
for (i in 1:(length(block)-1)) {
block.stmts <- c(block.stmts, parsed.stmts[[i+ptr]])
}
# Advance pointer for next block.
ptr <- ptr + length(block) - 1
# Wrap each statement with .ddg.eval.
block <- .ddg.wrap.block.with.ddg.eval(block, block.stmts)
# Add start and finish nodes.
block <- .ddg.add.block.start.finish(block, "if")
# Reconstruct original statement.
cond <- paste(deparse(parent[[2]]), collapse="")
if (bnum == 1) {
statement.txt <- paste(c(paste("if (", cond, ")", sep=""),
deparse(block), collapse="\n"))
} else {
statement.txt <- paste(c(paste("} else if (", cond, ")", sep=""),
deparse(block), collapse="\n"))
}
# Remove final brace & new line.
if (bnum > 1) {
last <- length(parsed.command.txt) - 2
parsed.command.txt <- parsed.command.txt[c(1:last)]
}
parsed.command.txt <- append(parsed.command.txt, statement.txt)
# Check for possible final else.
if (length(parent) == 4) {
final.else <- TRUE
} else {
final.else <- FALSE
}
# Get next parent
bnum <- bnum + 1
parent <- parent[[(length(parent))]]
}
# Final else block (if any).
if (final.else) {
# Get block.
block <- parent
block <- .ddg.ensure.in.block(block)
# Get statements for this block
block.stmts <- list()
for (i in 1:(length(block)-1)) {
block.stmts <- c(block.stmts, parsed.stmts[[i+ptr]])
}
# Wrap each statement with .ddg.eval.
block <- .ddg.wrap.block.with.ddg.eval(block, block.stmts)
# Add start and finish nodes.
block <- .ddg.add.block.start.finish(block, "if")
# Reconstruct original statement
statement.txt <- paste(c(paste("} else", sep=""), deparse(block), collapse=""))
# Remove final brace.
last <- length(parsed.command.txt) - 2
parsed.command.txt <- parsed.command.txt[c(1:last)]
parsed.command.txt <- append(parsed.command.txt, statement.txt)
}
}
parsed.command.txt <-
append(parsed.command.txt, ".ddg.set.inside.loop()", after = 0)
parsed.command.txt <-
append(parsed.command.txt, ".ddg.not.inside.loop()")
#print(paste(".ddg.annotate.if.statement annotated version:", parsed.command.txt))
return(parse(text=parsed.command.txt))
}
#' .ddg.annotate.loop.statement adds annotations to for, while and repeat
#' statements. Provenance is collected for the number of iterations
#' specified in the parameter max.loops, beginning with the iteration
#' specified in the parameter first.loop. A Details Omitted node may be
#' added before and after the annotated section, as needed.
#' @param command original parsed command
#' @param loop.type loop type (for, while, repeat)
#' @return parsed command with annotationa added
#' @noRd
.ddg.annotate.loop.statement <- function(command, loop.type) {
if (.ddg.max.loops() == 0) {
# Note that I can't just use command@text because it does not separate
# statements with newlines
parsed.command.txt <- deparse(command@parsed[[1]])
}
else {
# Get parsed command
parsed.command <- command@parsed[[1]]
# Add new loop & get loop number.
ddg.loop.num <- .ddg.add.loop()
# Get statements in block.
if (loop.type == "for") {
block <- parsed.command[[4]]
}
else if (loop.type == "while") {
block <- parsed.command[[3]]
}
else { # repeat
block <- parsed.command[[2]]
}
# Add braces if necessary.
block <- .ddg.ensure.in.block(block)
# Wrap each statement with .ddg.eval.
annotated.block <- .ddg.wrap.block.with.ddg.eval(block, command@contained)
# Insert .ddg.forloop statement.
if (loop.type == "for") {
index.var <- parsed.command[[2]]
annotated.block <- .ddg.insert.ddg.forloop(annotated.block, index.var)
}
# Add start and finish nodes.
annotated.block <- .ddg.add.block.start.finish(annotated.block,
paste(loop.type, "loop"))
# Insert ddg.loop.annotate statements.
block <- .ddg.insert.ddg.loop.annotate(block, "off")
# Reconstruct for statement.
block.txt <- deparse(block)
annotated.block.txt <- deparse(annotated.block)
# Calculate the control line of the annotated code
if (loop.type == "for") {
firstLine <- paste("for (", deparse(parsed.command[[2]]), " in ",
deparse(parsed.command[[3]]), ") {", sep="")
}
else if (loop.type == "while") {
firstLine <- paste("while (", deparse(parsed.command[[2]]), ") {", sep="")
}
else { # repeat
firstLine <- paste("repeat {", sep="")
}
parsed.command.txt <- paste(c(firstLine,
paste("if (.ddg.loop.count.inc(", ddg.loop.num,
") >= .ddg.first.loop() && .ddg.loop.count(", ddg.loop.num,
") <= .ddg.first.loop() + .ddg.max.loops() - 1)", sep=""),
annotated.block.txt,
paste("else", sep = ""),
block.txt,
paste("}", sep=""),
paste("if (.ddg.loop.count(", ddg.loop.num,
") > .ddg.first.loop() + .ddg.max.loops() - 1)",
" .ddg.details.omitted()", sep=""),
paste(".ddg.reset.loop.count(", ddg.loop.num, ")", sep=""),
# Turn loop annotations back on in case we reached the max.
paste("if (.ddg.max.loops() != 0) .ddg.loop.annotate.on()"),
collapse="\n"))
}
parsed.command.txt <-
append(parsed.command.txt, ".ddg.set.inside.loop()", after = 0)
parsed.command.txt <-
append(parsed.command.txt, ".ddg.not.inside.loop()")
#print(parse(text=parsed.command.txt))
return(parse(text=parsed.command.txt))
}
#' .ddg.annotate.simple.block adds annotations to simple blocks.
#' @param command original parsed command
#' @return parsed command with annotations added
#' @noRd
.ddg.annotate.simple.block <- function(command) {
# Get parsed command
parsed.command <- command@parsed[[1]]
# Get statements in block.
block <- parsed.command
# Wrap each statement with .ddg.eval.
block <- .ddg.wrap.block.with.ddg.eval(block, command@contained)
# Add start and finish nodes.
block <- .ddg.add.block.start.finish(block, "block")
# Reconstruct block.
block.txt <- deparse(block)
return(parse(text=block.txt))
}
#' .ddg.is.call.to.ddg.function returns TRUE if the parsed expression
#' passed in is a call to a ddg function.
#' @param parsed.expr a parse tree
#' @return True if a call to a ddg function
#' @noRd
.ddg.is.call.to.ddg.function <- function(parsed.expr) {
# Check if a function call.
if (is.call(parsed.expr)) {
# Check if the function called is a ddg function.
if (grepl("^ddg|^.ddg|^prov", parsed.expr[1])) {
return (TRUE)
}
}
return (FALSE)
}
#' Creates a call to .ddg.eval using a closure so that we
#' will be able to refer to the correct DDGStatement object when the
#' return call is executed.
#' @param statement the parse tree for the expression being returned
#' @param parsed.stmt the DDGStatement object corresponding to the last statement
#' @return a parse tree with a call to .ddg.eval. The arguments to
#' .ddg.eval are the original statement and the DDGStatement object.
#' @noRd
.ddg.create.ddg.eval.call <- function (statement, parsed.stmt) {
# We need to force the evaluation of parsed.stmt for the closure to
# return the value that parsed.stmt has at the time the .ddg.eval
# call is created.
force(parsed.stmt)
return (call(".ddg.eval", paste(deparse(statement), collapse=""),
function() parsed.stmt))
}
#' Creates a call to .ddg.eval using the number of the DDGStatement
#' stored in the list ddg.statements in the ddg environment.
#' @param statement the parse tree for the expression being returned and
#' @param parsed.stmt the corresponding DDGStatement object.
#' @return a parse tree with a call to .ddg.eval. The arguments to
#' .ddg.eval are the original statement and the number of the DDGStatement object.
#' @noRd
.ddg.create.block.ddg.eval.call <- function (statement, parsed.stmt) {
# Get the next DDGStatement number and store parsed.stmt at this location.
.ddg.inc("ddg.statement.num")
num <- .ddg.statement.num()
.ddg.add.ddgstatement(parsed.stmt)
return (call(".ddg.eval", paste(deparse(statement), collapse=""), num))
}
#'.ddg.wrap.block.with.ddg.eval wraps each statement in a block with
#' .ddg.eval unless the statement is a ddg function or contains a call
#' to .ddg.return.value.
#' @param block original block
#' @param parsed.stmts parsed statements in block
#' @return block with annotations added
#' @noRd
.ddg.wrap.block.with.ddg.eval <- function(block, parsed.stmts) {
# Ignore initial brace.
for (i in 2:length(block)) {
# Enclose statement in quotation marks and wrap with .ddg.eval.
statement <- block[[i]]
if (!grepl("^ddg", statement) && !grepl("^.ddg", statement)
&& !grepl("^prov", statement)
&& !.ddg.has.call.to(statement, ".ddg.return.value")) {
parsed.stmt <- parsed.stmts[[i-1]]
# print(statement)
# print(parsed.stmt@text)
new.statement <- .ddg.create.block.ddg.eval.call(statement, parsed.stmt)
block[[i]] <- new.statement
}
}
return(block)
}
#' .ddg.add.block.start.finish adds start and finish nodes to blocks in control
#' statements.
#' @param block original block
#' @param pname label for start and finish nodes
#' @return block with annotations added
#' @noRd
.ddg.add.block.start.finish <- function(block, pname) {
# Create .ddg.start & .ddg.finish statements.
start.statement <- deparse(call(".ddg.start", pname))
finish.statement <- deparse(call(".ddg.finish", pname))
# Get internal statements.
pos <- length(block)
statements <- deparse(block[[2]])
if (pos > 2) {
for (i in 3:pos) {
statements <- append(statements, deparse(block[[i]]))
}
}
# Create new block.
block.txt <- paste(c("{", start.statement, statements, finish.statement, "}"),
collapse="\n")
block.parsed <- parse(text=block.txt)
return(block.parsed[[1]])
}
#' .ddg.insert.ddg.forloop inserts a .ddg.forloop statement at the top of a block.
#' @param block original block
#' @param index.var index variable
#' @return block with annotations added
#' @noRd
.ddg.insert.ddg.forloop <- function(block, index.var) {
pos <- length(block)
inserted.statement <- call(".ddg.forloop", index.var)
# Block with single statement.
if (pos == 2) {
new.statements <- c(as.list(block[[1]]), inserted.statement,
as.list(block[2]))
return(as.call(new.statements))
}
# Block with multiple statements.
else {
new.statements <- c(as.list(block[[1]]), inserted.statement,
as.list(block[2:pos]))
return(as.call(new.statements))
}
}
#' .ddg.insert.ddg.loop.annotate inserts a .ddg.loop.annotate.on or
#' .ddg.loop.annotate.off statement at the beginning of a block.
#' @param block original block
#' @param var whether loop annotation is on or off
#' @return block with annotations added
#' @noRd
.ddg.insert.ddg.loop.annotate <- function(block, var) {
pos <- length(block)
if (var == "on") inserted.statement <- call(".ddg.loop.annotate.on")
else if (var == "off") inserted.statement <- call(".ddg.loop.annotate.off")
# Block with single statement.
if (pos == 2) {
new.statements <- c(as.list(block[[1]]), inserted.statement,
as.list(block[2]))
return(as.call(new.statements))
}
# Block with multiple statements.
else {
new.statements <- c(as.list(block[[1]]), inserted.statement,
as.list(block[2:pos]))
return(as.call(new.statements))
}
}
#' prov.set.detail sets the level of detail for the provenance to be
#' collected.
#'
#' @param detail.level level of detail to set (0-3)
#' @export
#' @rdname prov.annotate.on
prov.set.detail <- function(detail.level) {
# If argument is missing, display help message.
if (missing(detail.level)) detail.level <- 4
if (detail.level == 0) {
.ddg.set("ddg.annotate.inside", FALSE)
.ddg.set("ddg.max.loops", 0)
.ddg.set("ddg.snapshot.size", 0)
.ddg.set("ddg.detail", 0)
} else if (detail.level == 1) {
.ddg.set("ddg.annotate.inside", TRUE)
.ddg.set("ddg.max.loops", 1)
.ddg.set("ddg.snapshot.size", 10)
.ddg.set("ddg.detail", 1)
} else if (detail.level == 2) {
.ddg.set("ddg.annotate.inside", TRUE)
.ddg.set("ddg.max.loops", 10)
.ddg.set("ddg.snapshot.size", 100)
.ddg.set("ddg.detail", 2)
} else if (detail.level == 3) {
.ddg.set("ddg.annotate.inside", TRUE)
.ddg.set("ddg.max.loops", 10^10)
.ddg.set("ddg.snapshot.size", Inf)
.ddg.set("ddg.detail", 3)
} else {
print("Please enter one of the following values:")
print("0 = no internal annotation, no snapshots")
print("1 = 1 loop, snapshots < 10k")
print("2 = 10 loops, snapshots < 100k")
print("3 = all loops, all snapshots")
}
}
#' prov.get.detail returns the current level of provenance detail.
#' @return prov.get.detail returns the current level of provenance
#' detail (0-3). Returns NULL if prov.set.detail was not previously
#' called, or has been cleared.
#' @export
#' @rdname prov.annotate.on
prov.get.detail <- function() {
if (!.ddg.is.set("ddg.detail")) .ddg.set("ddg.detail", NULL)
return(.ddg.get("ddg.detail"))
}
#' prov.clear.detail clears the current value of provenance detail.
#' The level of detail is then determined by parameters of prov.run
#' or prov.init.
#' @export
#' @rdname prov.annotate.on
prov.clear.detail <- function() {
.ddg.set("ddg.detail", NULL)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.