Nothing
# eHelp.R
# -- M.Ponce
# Enhanced-Help Function: ehelp()
# enhanced help function, capable of extracting "a-la docstring" comments
# and parse them into help and information messages using help()
ehelp <-function(fun, fn.name=as.character(substitute(fun)), coloring=FALSE, output="none") {
#' Enhanced-Help Function: ehelp()
#' This function displays docstring style comments used as help liners for user
#' defined functions.
#' @param fun function name of an user-defined function
#' @param fn name of the function (string)
#' @param coloring a Boolean flag indicating whether to use colors for displaying messages
#' @param output specify if the documentation generated by the ehelp() will be saved in a file, possible values are "txt" (for help only), "TXT" (for help and full fn body) or "none" (default, for in screen display only)
#'
#' @importFrom utils capture.output
#' @export
#'
#' @examples
#' myTestFn <- function(x,y,z,t=0) {
#' #'
#' #' This is just an example of a dummy fn
#' #'
#' #'
#' #' @email myemail@somewhere.org
#' #' @author author
#' #
#' #
#' #' @demo
#' #' @examples myTestFn(x0,y0,z0)
#' }
#'
#' ehelp(myTestFn)
#'
#' ## this requires the "crayon" package to work
#' ehelp(myTestFn, coloring=TRUE)
#'
#' ## generation of documentation for a fn in different formats
#' ## by indicating a particular format, ehelp will save in a file
#' ## the corresponding documentation of the selected fn
#' ## Valid formats are:
#' ## txt (plain-text), ascii (text with ESC-codes for coloring),
#' ## latex, html, markdown
#' ## Additionally, capitalized versions of these formats, will also include
#' ## the listing of the fn
#'
#'\dontrun{
#' ehelp(myTestFn, output="latex")
#' ehelp(myTestFn, output="TXT")
#' ehelp(myTestFn, coloring=TRUE, output="HTML")
#' ehelp(myTestFn, coloring=TRUE, output="ASCII")
#' ehelp(myTestFn, coloring=TRUE, output="markdown")
#'}
#'
####################
# define structure for the ehelp-object
#ehelp.obj <- list()
ehelp.obj <- data.frame(code=character(),txt=character(), stringsAsFactors=F)
#class(ehelp.obj) <- "ehelp"
####################
#############################################################
# internal function to obtain first word after a keyword...
#' @keywords internal
firstWord <- function(strLine,kwrd) {
clean.leading.spaces <- sub("^\\s+", "", strLine)
pattern <- paste0(".*",kwrd,"\\s*| .*")
match <- gsub(pattern, "", clean.leading.spaces)
return(match)
}
#################
# internal function to obtain the arguments of a function using text parsing
#' @keywords internal
getFnArgs <- function(line1) {
# grab all the content between parenthesis...
return( gsub("[\\(\\)]", "", regmatches(line1, gregexpr("\\(.*?\\)", line1))[[1]]) )
}
#################
# internal function to remove the function label and extra spaces
#' @keywords internal
OnlyArgs <- function(line1) {
# remove the word "function" from the string
Args <- gsub("function","",line1)
# remove leading and trailing spaces
onlyArgs <- gsub("^\\s+|\\s+$", "", Args)
return(onlyArgs)
}
# internal function to obtain arguments of a function using the "args()" fn
#' @keywords internal
FnArgs <- function(fun) {
# obtain arguments of fun
fnCall <- gsub("^\\s+", "", as.character(capture.output(args(fun))))
# collapse fn call into one line and exclude the "NULL" returned from args()
# getArgs <- paste(fnCall[1:length(fnCall)-1], collpase="")
getArgs <- do.call(paste, c(as.list(fnCall[1:length(fnCall)-1]),collpase=""))
#print(getArgs)
# remove the word function and leading/trailing spaces
return( OnlyArgs(getArgs) )
}
################# internal functions for checks ###############################
# internal function to check whether packages are available and load them
#' @importFrom utils installed.packages
#' @keywords internal
check_pkg <- function(pckg) {
# if package is installed locally then load
if (pckg %in% rownames(installed.packages())) {
do.call('library', list(pckg))
return(TRUE)
} else {
return(FALSE)
}
}
##################
# internal function to check that a fn is present in the Global environment
# NEEDS FIX TO parse the fn name
checkFnGE <- function(fun, fn.name=as.character(substitute(fun)) ) {
print(fn.name)
# check whether the fn is an user-defined fn defined in the global environment
# if not found will return NULL
fun <- get0(fn.name, .GlobalEnv, inherits=FALSE)
if (is.null(fun)) {
stop(paste0('"',fn.name,'"'), " not present (not defined) in the current session!",'\n\n')
} else if(!is.function(fun)){
stop(paste0('"',fn.name,'"'), " defined in user-space memory but is NOT a function!",'\n\n')
}
}
##############################################################
# internal function to switch between commands to display information into console
#' @keywords internal
xcat <- function(msg,ehelp.obj, appendLF=FALSE, testing=FALSE){
if (!testing) {
ehelp.obj <- c(ehelp.obj, (msg)) #message(msg,appendLF=appendLF))
} else {
ehelp.obj <- c(ehelp.obj, (msg))
}
return(ehelp.obj)
}
# improved version of xcat() to use generic codes from ehelp.palette
xcat2 <- function(code, msg, ehelp.obj) {
spCodes <- ehelp.palette()
ehelp.code <- ""
if (code %in% spCodes$codes) ehelp.code <- code
ehelp.obj[dim(ehelp.obj)[1]+1,] <- rbind(ehelp.code,msg)
return(ehelp.obj)
}
##############################################################
##############################################################
# check that there is an argument passed into the function
if (missing(fun)) {
stop("ehelp() requires the name of a function to be used as an argument.",
'\n',
"Try using ehelp(ehelp).",
'\n')
} else {
# check that the function received actually exists in global space
#checkFnGE(fun)
fn <- get0(fn.name, .GlobalEnv, inherits=FALSE)
if (is.null(fn)) {
stop(paste0('"',fn.name,'"'), " not present (not defined) in the current session!",'\n\n')
} else if(!is.function(fun)){
stop(paste0('"',fn.name,'"'), " defined in user-space memory but is NOT a function!",'\n\n')
}
}
# check coloring... if it is set to TRUE, then attempt to load 'crayon'...
if (coloring) coloring <- check_pkg("crayon")
# define keywords to look for
keywords <- c("@fnName","@param","@descr","@return","@usage","@examples","@author", "@email", "@repo", "@ref")
# define keywords to avoid
kwrds.skip <- c("@keywords","@keywords internal","@importFrom","@export")
# keywords descriptions
keys.descrp <- c("Function Name:", "Arguments: \n", "Description: \n","\nReturn: \n","\n### Usage: \n", "\n### Examples: \n","Author:", "Contact:", "Repository/URL:", "References: \n")
names(keys.descrp) <- keywords
# counters...
keys.count <- rep(0,length(keywords))
names(keys.count) <- keywords
# first get the content of the function, i.e. its definition which should include the comments
fnCorpus <- capture.output(print(fun))
# get the function arguments
fn.args <- FnArgs(fn.name)
# identify the lines that contain the symbols "#'"
helperCmts <- grepl("^[[:space:]]*#\'", fnCorpus)
# intialize some containers for important info...
# for now use the name of the fn detetected in the wrapper function
fnName <- fn.name #as.character(substitute(fun))
fnArgs <- c()
# loop over the fn. corpus
for (i in 1:length(helperCmts)) {
# consider the lines marked as comments for help using "#'"
if (helperCmts[i]) {
#DBG: print(helperCmts[i])
# get the current line and prune the "#'"
fnLine <- gsub("#'","",fnCorpus[i])
#DBG: print(fnLine)
# some special cases to consider within the keywords: fnName & param
# check for parameters to the fn
if (grepl("@param",fnLine)) {
#argFn <- gsub(".*@param (.+) \ .*", "\\1", fnLine)
# clean leading spaces, and then grab the first 'word' after @param
#argFn <- gsub(".*@param\\s*| .*", "", sub("^\\s+", "", fnLine))
#fnArgs <- c(fnArgs,argFn)
fnArgs <- c(fnArgs,firstWord(fnLine,"@param"))
}
# function name
if (grepl("@fnName",fnLine)) {
fnName <- firstWord(fnLine,"@fnName")
}
# check for keywords in the helper lines...
flagKwrd <- FALSE
for (kwrd in keywords) {
if (grepl(kwrd,fnLine)) {
# check whether this is the first instance of this feature...
if (keys.count[kwrd] == 0) {
ehelp.obj <- xcat2(paste0("<<code_eHelp_",kwrd,">>"), keys.descrp[kwrd], ehelp.obj)
}
curLine <- gsub(kwrd,"",fnLine)
#print(paste0("<<code_eHelp_",kwrd,">>"))
ehelp.obj <- xcat2(paste0("<<code_eHelp_",kwrd,">>"), paste('\t',curLine,'\n'), ehelp.obj)
keys.count[kwrd] <- keys.count[kwrd] + 1
flagKwrd <- TRUE
}
}
if (!flagKwrd) {
# check whether the line does not include keywords to skip defined in kwrds.skip, eg. "@keywords internal"
if (sum(sapply(kwrds.skip, grepl, fnLine)) == 0) {
# just a comment line without any keyword...
ehelp.obj <- xcat2("", paste(fnLine,'\n'), ehelp.obj)
}
}
}
}
# summaryzing info...
ehelp.obj <- xcat2("<<code_eHelp_@usage>>", keys.descrp["@usage"],ehelp.obj)
ehelp.obj <- xcat2("<<code_eHelp_@usage>>", paste0('\t',paste0(fnName,fn.args), '\n'),ehelp.obj)
# process output request...
processOutput(ehelp.obj, fnName,fnCorpus, output)
#print(ehelp.obj)
# preparing for returing output and object...
class(ehelp.obj) <- "ehelp"
return(print.ehelp(ehelp.obj,coloring=coloring))
#return(ehelp.obj)
}
###########################################
# Wrapper Help Function
# help wrapper function to redirect the calls to help either to our help.fn or
# the system help (utils::help)
help <- function(topic, package = NULL, lib.loc = NULL, verbose = getOption("verbose"),
try.all.packages = getOption("help.try.all.packages"), help_type = getOption("help_type")) {
#' Wrapper Help Function
#'
#' This function is a wrapper around the R's system help() function.
#' It allows the user to include docstring styles documentation and
#' displayed it as help or information to the users using the help()
#' command.
#'
#' Parameters are the same as in utils::help, see help(help,package='utils') for further details.
#'
#' @param topic topic/or/function name to search for
#' @param package package where to search
#' @param lib.loc location of R libraries
#' @param verbose for diplaying the filename
#' @param try.all.packages attempt to go trough all installed packages
#' @param help_type format of the displayed help (text,html, or pdf)
#'
#' @examples
#' compute3Dveloc <- function(x,y,z,t){
#' #' @fnName compute3Dveloc
#' #' this function computes the velocity of an object in a 3D space
#' #' @param x vector of positions in the x-axis
#' #' @param y vector of positions in the y-axis
#' #' @param z vector of positions in the z-axis
#' #' @param t time vector corresponding to the position vector
#'
#' # number of elements in vectors
#' n <- length(t)
#' # compute delta_t
#' delta_t <- t[2:n]-t[1:n-1]
#' # compute delta_x
#' delta_x <- x[2:n]-x[1:n-1]
#' # compute delta_y
#' delta_y <- y[2:n]-y[1:n-1]
#' # compute delta_z
#' delta_z <- z[2:n]-z[1:n-1]
#' # do actual computation of velocity...
#' veloc3D <- list(delta_x/delta_t, delta_y/delta_t, delta_z/delta_t)
#' # return value
#' return(veloc3D)
#' }
#'
#' help(compute3Dveloc)
#'
#' @export
###################################################################
# this function is taken from the original "docstring" package,
# https://cran.r-project.org/web/packages/docstring/docstring.pdf
#
# and it has been modified to make it work with "help" instead of "?"
original <- function() {
# Recreates the call but uses utils::`?`
# So if we decide that docstring isn't the
# way to go then we can still treat the input
# like it would be treated if the docstring
# package wasn't loaded.
# TODO: Possibly try to play nice with devtools/sos?
originalCall[[1]] <- quote(utils::help)
return(eval(originalCall, parent.frame(2)))
}
###################################################################
# capture the original call to the fn
originalCall <- match.call()
# check that there is an argument passed into the function
if (missing(topic)) {
stop("Please provide an argument to the help function!",'\n')
}
# check whether it is not help for an specific package or library
if (is.null(package) & is.null(lib.loc)) {
# extract the name of the function/topic
fn <- as.character(substitute(topic))
# check whether the fn is an user-defined fn defined in the global environment
# if not found will return NULL
fun <- get0(fn, .GlobalEnv, inherits=FALSE)
if (!is.null(fun) && fn != "help") {
# check that it is indeed an user-defined fn
if (is.function(topic)) {
ehelp(topic,fn)
} else {
warning(paste0('"',fn,'"'), " defined in user-space memory but is NOT a function!",'\n\n')
}
} else {
# check whether the topic is in the actual R help system
return(original())
}
} else {
return(original())
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.