[Roxygen-commits] r71 - in pkg: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jul 21 14:31:50 CEST 2008
Author: pcd
Date: 2008-07-21 14:31:50 +0200 (Mon, 21 Jul 2008)
New Revision: 71
Modified:
pkg/R/Rd.R
pkg/R/collate.R
pkg/R/functional.R
pkg/R/list.R
pkg/R/namespace.R
pkg/R/parse.R
pkg/R/roclet.R
pkg/R/string.R
pkg/sandbox/main.R
Log:
recursive roxygen documentation; simplify cdr
Modified: pkg/R/Rd.R
===================================================================
--- pkg/R/Rd.R 2008-07-21 02:35:48 UTC (rev 70)
+++ pkg/R/Rd.R 2008-07-21 12:31:50 UTC (rev 71)
@@ -1,5 +1,16 @@
#' @include list.R
#' @include string.R
+roxygen()
+
+#' Make an Rd roclet which parses the result of \code{parse.files}
+#' and writes the Rd format to standard out (TODO: write
+#' to the file designated by \code{@name}). Requires the \code{@name}
+#' parameter.
+#'
+#' Contains the member function \code{parse} which parses the result
+#' of \code{parse.files}.
+#'
+#' @return Rd roclet
make.Rd.roclet <- function() {
Rd.expression <- function(key, ...)
sprintf('\\%s%s\n',
Modified: pkg/R/collate.R
===================================================================
--- pkg/R/collate.R 2008-07-21 02:35:48 UTC (rev 70)
+++ pkg/R/collate.R 2008-07-21 12:31:50 UTC (rev 71)
@@ -1,5 +1,15 @@
#' @include roclet.R
#' @include string.R
+roxygen()
+
+#' Make collate roclet which parses the result of \code{parse.files},
+#' topologically sorting \code{@include}s and writing a \code{collate} directive
+#' to standard out.
+#'
+#' Contains the member function \code{parse} which parses the result
+#' of \code{parse.files}.
+#'
+#' @return Rd roclet
make.collate.roclet <- function() {
vertices <- NULL
Modified: pkg/R/functional.R
===================================================================
--- pkg/R/functional.R 2008-07-21 02:35:48 UTC (rev 70)
+++ pkg/R/functional.R 2008-07-21 12:31:50 UTC (rev 71)
@@ -1,16 +1,28 @@
-## Thanks, Byron Ellis.
-## https://stat.ethz.ch/pipermail/r-devel/2007-November/047318.html
+#' Pre-specify a procedures named parameters, returning a new procedure.
+#'
+#' Thanks, Byron Ellis.
+#' \url{https://stat.ethz.ch/pipermail/r-devel/2007-November/047318.html}
+#' @param FUN the function to be curried
+#' @param \dots the determining parameters
+#' @return A new function partially determined
Curry <- function(FUN,...) {
.orig = list(...);
function(...) do.call(FUN,c(.orig,list(...)))
}
-## Borrowed from src/library/base/R/funprog.R for pre-2.7 Rs.
+#' Negate a function; borrowed from src/library/base/R/funprog.R for
+#' pre-2.7 Rs.
+#' @param f the function to be negated
+#' @return The negated function
Negate <- function(f)
function(...) ! match.fun(f)(...)
-## My Happy Hacking keyboard gave out during the writing of this
-## procedure; moment of silence, please.
+#' Compose an arbitrary number of functions.
+#
+#' My Happy Hacking keyboard gave out during the writing of this
+#' procedure; moment of silence, please.
+#' @param \dots the functions to be composed
+#' @return A composed function
Compose <- function(...) {
fs <- list(...)
function(...) Reduce(function(x, f) f(x),
@@ -18,5 +30,9 @@
...)
}
-## Is concatenation benign?
+#' Identity function.
+#'
+#' Is concatenation benign?
+#' @param \dots tautological arguments
+#' @return The tautologized arguments, concatenated
Identity <- function(...) c(...)
Modified: pkg/R/list.R
===================================================================
--- pkg/R/list.R 2008-07-21 02:35:48 UTC (rev 70)
+++ pkg/R/list.R 2008-07-21 12:31:50 UTC (rev 71)
@@ -1,65 +1,112 @@
+#' The empty list
nil <- list()
+#' Whether a list is empty.
+#' @param list the list to test
+#' @return Whether the list is empty
is.nil <- function(list)
length(list) == 0 || is.null(car(list))
-car <- function(list) {
+#' First element of a list
+#' @param list the list to first
+#' @return The first element
+car <- function(list)
list[[1]]
-}
+#' Return elements after the first of a list.
+#' @param list the list from which to extract
+#' @return The elements after the first, or \code{nil}
+#' if only one
cdr <- function(list) {
+ if (is.nil(list))
+ stop('CDRing a null list')
length <- length(list)
- cdr <- switch(length + 1,
- stop('CDRing a null list'),
- nil)
- if(is.null(cdr))
+ if (length == 1)
+ nil
+ else
list[2:length]
- else
- cdr
}
+#' Composite \code{car}/\code{cdr}
+#' @param list the list from which to extract
+#' @return The extracted elements
caar <- function(list) {
car(car(list))
}
+#' Composite \code{car}/\code{cdr}
+#' @param list the list from which to extract
+#' @return The extracted elements
cadr <- function(list) {
car(cdr(list))
}
+#' Composite \code{car}/\code{cdr}
+#' @param list the list from which to extract
+#' @return The extracted elements
cddr <- function(list) {
cdr(cdr(list))
}
+#' Composite \code{car}/\code{cdr}
+#' @param list the list from which to extract
+#' @return The extracted elements
caddr <- function(list) {
car(cddr(list))
}
+#' Composite \code{car}/\code{cdr}
+#' @param list the list from which to extract
+#' @return The extracted elements
cadar <- function(list) {
cadr(car(list))
}
+#' Is a number even?
+#' @param a the number to test
+#' @return Whether the number is even
is.even <- function(a) {
a %% 2 == 0
}
+#' Is a number odd?
+#' @param a the number to test
+#' @return Whether the number is odd
is.odd <- function(a) {
Negate(is.even)(a)
}
+#' Zip \emph{n} lists together into tuplets of
+#' length \emph{n}.
+#' @param zipper the zipping function
+#' @param dots the lists to be zipped
+#' @return A list of tuplets
zip <- function(zipper, ...) {
m <- mapply(zipper, ...)
split(m, col(m))
}
-
+#' Zip using \code{c}.
+#' @param \dots the lists to be zipped
+#' @return A list of tuplets
+#' @seealso \code{\link{zip}}
zip.c <- function(...) {
zip(c, ...)
}
+#' Zip using \code{list}.
+#' @param \dots the lists to be zipped
+#' @return A list of tuplets
+#' @seealso \code{\link{zip}}
zip.list <- function(...) {
zip(list, ...)
}
+#' Combine a list into pairwise elements; lists should
+#' be of the same length. In case of odd numbers of members,
+#' the last will be removed.
+#' @param list the list to be pairwise decomposed
+#' @return A list of pairwise elements
pairwise <- function(list) {
length <- length(list)
if (length < 2)
Modified: pkg/R/namespace.R
===================================================================
--- pkg/R/namespace.R 2008-07-21 02:35:48 UTC (rev 70)
+++ pkg/R/namespace.R 2008-07-21 12:31:50 UTC (rev 71)
@@ -1,5 +1,14 @@
#' @include roclet.R
#' @include string.R
+roxygen()
+
+#' Make a namespace roclet which parses the result of \code{parse.files}
+#' and writes a list of namespace directives to standard out.
+#'
+#' Contains the member function \code{parse} which parses the result
+#' of \code{parse.files}.
+#'
+#' @return Namespace roclet
make.namespace.roclet <- function() {
parse.directive <- function(proc, parms)
cat(sprintf('%s(%s)\n', proc, strmap(Identity, ', ', parms)))
Modified: pkg/R/parse.R
===================================================================
--- pkg/R/parse.R 2008-07-21 02:35:48 UTC (rev 70)
+++ pkg/R/parse.R 2008-07-21 12:31:50 UTC (rev 71)
@@ -4,9 +4,15 @@
TAG.DELIMITER <- '@'
#' No-op for sourceless files
+#' @return \code{NULL}
roxygen <- function() NULL
#' Comment blocks (possibly null) that precede a file's expressions.
+#' @param srcfile result of running \code{srcfile} on an interesting
+#' file
+#' @param srcrefs the resultant srcrefs
+#' @return A list of prerefs that resemble srcrefs in form, i.e.
+#' with srcfile and lloc
prerefs <- function(srcfile, srcrefs) {
length.line <- function(lineno)
nchar(getSrcLines(srcfile, lineno, lineno))
@@ -26,39 +32,87 @@
Map(pair.preref, pairs)
}
+#' Preref parser table
preref.parsers <- new.env(parent=emptyenv())
+#' Srcref parser table
srcref.parsers <- new.env(parent=emptyenv())
+#' Register a parser with a table
+#' @param table the table under which to register
+#' @param key the key upon which to register
+#' @param parser the parser callback to register;
+#' a function taking \code{key} and \code{expression}
+#' @return \code{NULL}
register.parser <- function(table, key, parser)
table[[key]] <- parser
+#' Specifically register a preref parser
+#' @param key the key upon which to register
+#' @param parser the parser callback to register;
+#' a function taking \code{key} and \code{expression}
+#' @return \code{NULL}
+#' @seealso \code{\link{register.parser}}
register.preref.parser <- Curry(register.parser,
table=preref.parsers)
+#' Specifically register a srcref parser
+#' @param key the key upon which to register
+#' @param parser the parser callback to register;
+#' a function taking \code{key} and \code{expression}
+#' @return \code{NULL}
+#' @seealso \code{\link{register.parser}}
register.srcref.parser <- Curry(register.parser,
table=preref.parsers)
+#' Register many parsers at once.
+#' @param table the table under which to register
+#' @param parser the parser to register
+#' @param \dots the keys upon which to register
+#' @return \code{NULL}
register.parsers <- function(table, parser, ...) {
for (key in c(...))
register.parser(table, key, parser)
}
+#' Register many preref parsers at once.
+#' @param parser the parser to register
+#' @param \dots the keys upon which to register
+#' @return \code{NULL}
register.preref.parsers <- Curry(register.parsers,
table=preref.parsers)
+#' Register many srcref parsers at once.
+#' @param parser the parser to register
+#' @param \dots the keys upon which to register
+#' @return \code{NULL}
register.srcref.parsers <- Curry(register.parsers,
table=srcref.parsers)
+#' Centrally formatted message
+#' @param key the offending key
+#' @param message the apposite message
+#' @return The formatted message
parse.message <- function(key, message)
sprintf('@%s %s.', key, message)
+#' Centrally formatted error; stopping execution
+#' @param key the offending key
+#' @param message the apposite message
+#' @return \code{NULL}
parse.error <- function(key, message)
stop(parse.message(key, message))
+#' Centrally formatted warning
+#' @param key the offending key
+#' @param message the apposite message
+#' @return \code{NULL}
parse.warning <- function(key, message)
warning(parse.message(key, message))
+#' Parse a raw string containing key and expressions.
+#' @param element the string containing key and expressions
+#' @return A list containing the parsed constituents
parse.element <- function(element) {
tag <- strcar(element)
rest <- strcdr(element)
@@ -66,23 +120,42 @@
do.call(parser, list(tag, rest))
}
-## preref parsers
-
+#' Parse description: the premier part of a roxygen block
+#' containing description and option details separated by
+#' a blank roxygen line.
+#' @param expression the description to be parsed
+#' @return A list containing the parsed description
parse.description <- function(expression)
list(description=expression)
+#' Default parser which simply emits the key and expression.
+#' @param key the parsing key
+#' @param rest the expression to be parsed
+#' @return A list containing the key and expression (possibly
+#' null)
parse.default <- function(key, rest)
as.list(structure(rest, names=key))
+#' Resorts to the default parser but with a warning about the
+#' unknown key.
+#' @param key the parsing key
+#' @param rest the expression to be parsed
+#' @return A list containing the key and expression (possibly
+#' null)
+#' @seealso \code{\link{parse.default}}
parse.preref <- function(key, rest) {
parse.warning(key, 'is an unknown key')
parse.default(key, rest)
}
-## Possibly NA; in which case, the Roclets can do something more
-## sophisticated with the srcref.
+#' Possibly NA; in which case, the Roclets can do something more
+#' sophisticated with the srcref.
register.preref.parser('export', parse.default)
+#' Parse an element with a mandatory value.
+#' @param key the parsing key
+#' @param rest the expression to be parsed
+#' @return A list containing the key and value
parse.value <- function(key, rest) {
if (is.null.string(rest))
parse.error(key, 'requires a value')
@@ -114,6 +187,12 @@
'author',
'include')
+#' Parse an element containing a mandatory name
+#' and description (such as @param).
+#' @param key the parsing key
+#' @param rest the expression to be parsed
+#' @return A list containing the key, name and
+#' description
parse.name.description <- function(key, rest) {
name <- strcar(rest)
rest <- strcdr(rest)
@@ -129,6 +208,11 @@
'slot',
'param')
+#' Parse an element containing a single name and only a name;
+#' extra material will be ignored and a warning issued.
+#' @param key parsing key
+#' @param name the name to be parsed
+#' @return A list containing key and name
parse.name <- function(key, name) {
if (is.null.string(name))
parse.error(key, 'requires a name')
@@ -141,6 +225,10 @@
'S3class',
'returnType')
+#' Turn a binary element on; parameters are ignored.
+#' @param key parsing key
+#' @param rest the expression to be parsed
+#' @return A list with the key and \code{TRUE}
parse.toggle <- function(key, rest)
as.list(structure(T, names=key))
@@ -149,44 +237,77 @@
'attributeObject',
'environmentObject')
-## srcref parsers
-
+#' By default, srcrefs are ignored; this parser returns \code{nil}.
+#' @param pivot the parsing pivot
+#' @param expression the expression to be parsed
+#' @return \code{nil}
parse.srcref <- function(pivot, expression) nil
+#' Parse S4 \code{setClass} method.
+#' @param pivot the parsing pivot
+#' @param expression the expression to be parsed
+#' @return An list containing the class to be set
register.srcref.parser('setClass',
function(pivot, expression)
list(class=cadr(car(expression))))
+#' Parse S4 \code{setGeneric} method.
+#' @param pivot the parsing pivot
+#' @param expression the expression to be parsed
+#' @return A list containing the generic
register.srcref.parser('setGeneric',
function(pivot, expression)
list(generic=cadr(car(expression))))
+
+#' Parse S4 \code{setMethod} method.
+#' @param pivot the parsing pivot
+#' @param expression the expression to be parsed
+#' @return A list containing the method to be set
register.srcref.parser('setMethod',
function(pivot, expression)
list(method=cadr(car(expression)),
signature=caddr(car(expression))))
-## Parser lookup
-
+#' Default parser-lookup; if key not found, return
+#' the default parser specified.
+#' @param table the parser table from which to look
+#' @param key the key upon which to look
+#' @param default the parser to return upon unsuccessful
+#' lookup
+#' @return The parser
parser.default <- function(table, key, default)
if (is.null(f <- table[[key]])) default else f
+#' Preref parser-lookup; defaults to \code{parse.preref}.
+#' @param key the key upon which to look
+#' @return The parser
parser.preref <- Curry(parser.default,
table=preref.parsers,
default=parse.preref)
+#' Srcref parser-lookup; defaults to \code{parse.srcref}.
+#' @param key the key upon which to look
+#' @return The parser
parser.srcref <- Curry(parser.default,
table=srcref.parsers,
default=parse.srcref)
-## File -> {src,pre}ref mapping
-
+#' Parse either srcrefs, prerefs or pairs of the same.
+#' @param x the srcref, preref or pair of the same
+#' @return List containing the parsed srcref/preref
parse.ref <- function(x, ...)
UseMethod('parse.ref')
+#' Parse a preref/srcrefs pair
+#' @param preref.srcref the preref/srcref pair
+#' @return List combining the parsed preref/srcref
parse.ref.list <- function(preref.srcref)
append(parse.ref(car(preref.srcref)),
parse.ref(cadr(preref.srcref)))
+#' Parse a preref
+#' @param preref the preref to be parsed
+#' @return List containing the parsed preref
parse.ref.preref <- function(preref) {
lines <- getSrcLines(attributes(preref)$srcfile,
car(preref),
@@ -225,6 +346,9 @@
}
}
+#' Parse a srcref
+#' @param srcref the srcref to be parsed
+#' @return List containing the parsed srcref
parse.ref.srcref <- function(srcref) {
srcfile <- attributes(srcref)$srcfile
lines <- getSrcLines(srcfile, car(srcref), caddr(srcref))
@@ -240,9 +364,15 @@
parsed
}
+#' Parse each of a list of preref/srcref pairs.
+#' @param preref.srcrefs list of preref/srcref pairs
+#' @return List combining parsed preref/srcrefs
parse.refs <- function(preref.srcrefs)
Map(parse.ref, preref.srcrefs)
+#' Parse a source file containing roxygen directives.
+#' @param file string naming file to be parsed
+#' @return List containing parsed directives
parse.file <- function(file) {
srcfile <- srcfile(file)
srcrefs <- attributes(parse(srcfile$filename,
@@ -253,5 +383,9 @@
nil
}
+#' Parse many files at one.
+#' @param \dots files to be parsed
+#' @return List containing parsed directives
+#' @seealsa \code{\link{parse.file}}
parse.files <- function(...)
Reduce(append, Map(parse.file, list(...)), NULL)
Modified: pkg/R/roclet.R
===================================================================
--- pkg/R/roclet.R 2008-07-21 02:35:48 UTC (rev 70)
+++ pkg/R/roclet.R 2008-07-21 12:31:50 UTC (rev 71)
@@ -1,4 +1,25 @@
#' @include list.R
+roxygen()
+
+#' Abstract roclet that serves as a rudimentary API.
+#'
+#' Contains the following member functions:
+#' \item{register.parser}{takes \code{key} and \code{parser}}
+#' \item{register.parsers}{takes \code{parser} and \code{keys}}
+#' \item{register.default.parser}{takes a \code{key}}
+#' \item{register.default.parsers}{take \code{parsers}}
+#' \item{parse}{parses material returned by \code{parse.files}}
+#'
+#' @param parse.default the default parser taking \code{key}
+#' and \code{value}
+#' @param pre.parse a callback function taking a list of parsed
+#' elements; called before processing a file
+#' @param post.parse a callback function taking a list of parsed
+#' elements; called after processing a file
+#' @param pre.files a callback function with no arguments;
+#' called before any file has been parsed
+#' @param post.files a callback function with no arguments;
+#' called after every file has been parsed
make.roclet <- function(parse.default,
pre.parse=NULL,
post.parse=NULL,
@@ -50,5 +71,11 @@
structure(roclet, class='roclet')
}
+#' Assign a variable in the parent environment when \code{<<-}
+#' doesn't see to work.
+#' @param var string of the variable to assign
+#' @param value value to be assigned
+#' @param env environment of the assignment (\code{environment()})
+#' @return NULL
assign.parent <- function(var, value, env)
assign(var, value, envir=parent.env(env))
Modified: pkg/R/string.R
===================================================================
--- pkg/R/string.R 2008-07-21 02:35:48 UTC (rev 70)
+++ pkg/R/string.R 2008-07-21 12:31:50 UTC (rev 71)
@@ -4,22 +4,47 @@
MATTER <- '[^[:space:]]+'
NIL.STRING <- ''
+#' Trim [:space:] to the left of a string.
+#' @param string the string to be trimmed
+#' @return A left-trimmed string
trim.left <- function(string)
gsub(sprintf('^%s', SPACE), NIL.STRING, string)
+#' Trim [:space:] to the right of a string.
+#' @param string the string to be trimmed
+#' @return A right-trimmed string
trim.right <- function(string)
gsub(sprintf('%s$', SPACE), NIL.STRING, string)
+#' Trim [:space:] on both sides of a string.
+#' @param string the string to be trimmed
+#' @return A trimmed string
trim <- function(string)
Compose(trim.left, trim.right)(string)
-is.null.string <- function(string) regexpr(MATTER, string) < 0
+#' Does the string contain no matter, but very well [:space:]?
+#' @param string the string to check
+#' @return TRUE if the string contains words, otherwise FALSE
+is.null.string <- function(string)
+ regexpr(MATTER, string) < 0
+#' Number of words a string contains.
+#' @param string the string whose words to count
+#' @return Number of words in the string
nwords <- function(string) {
if (is.null.string(string)) 0
else length(gregexpr(MATTER, string))
}
+#' Find the nth word in a string.
+#' @param string the string to search in
+#' @param n the nth word to find
+#'
+#' @return A list containing:
+#' \item{start}{the first letter of the word.}
+#' \item{end}{the last letter of the word.}
+#' Undefined if no such word; though \code{end} may be less than
+#' \code{start} in such a case.
word.ref <- function(string, n) {
continue <- function(string, n, init) {
word <- regexpr(MATTER, string)
@@ -32,6 +57,9 @@
continue(string, n, 0)
}
+#' First word in a string.
+#' @param string the string whose word to finde
+#' @return The first word
strcar <- function(string) {
if (is.null.string(string))
stop('CARing null-string')
@@ -39,6 +67,9 @@
substr(string, ref$start, ref$end - 1)
}
+#' Words after first in a string.
+#' @param string the string whose words to find
+#' @return The words after first in the string
strcdr <- function(string) {
if (is.null.string(string))
stop('CDRing null-string')
@@ -49,13 +80,25 @@
substr(string, ref$start, nchar(string))
}
+#' Join two string.
+#' @param consor the joining string
+#' @param consee the joined string
+#' @param sep the intervening space
+#' @return The joined strings
strcons <- function(consor, consee, sep) {
if (is.null.string(consee)) consor
else paste(consor, consee, sep=sep)
}
-## General enough to be designated `map': isn't it closer to a
-## specialized reduce?
+#' Map through the words in a string, joining the mapped
+#' words with a separator.
+#'
+#' General enough to be designated `map': isn't it closer to a
+#' specialized reduce?
+#' @param proc procedure to apply to each word
+#' @param sep the separator joining the mapped words
+#' @param string the string to be mapped
+#' @return Mapped words separated by \code{sep}
strmap <- function(proc, sep, string) {
continue <- function(string)
if (is.null.string(string))
@@ -67,6 +110,10 @@
continue(string)
}
+#' Convenience function to print variable-value pairs.
+#'
+#' @param \dots named variable of the form a=b, \dots
+#' @return NULL
debug <- function(...) {
values <- list(...)
var.values <- zip.list(attributes(values)$names, values)
@@ -77,6 +124,11 @@
'\n')
}
+#' Ad-hoc abstraction to paste processed list-elements together.
+#' @param proc the procedure to apply to the elements
+#' @param elts the elements to be processed
+#' @param sep the glue to joined the processed elements
+#' @return The processed elements as a glued string
Reduce.paste <- function(proc, elts, sep)
Reduce(function(parsed, elt)
Curry(paste, sep=sep)
Modified: pkg/sandbox/main.R
===================================================================
--- pkg/sandbox/main.R 2008-07-21 02:35:48 UTC (rev 70)
+++ pkg/sandbox/main.R 2008-07-21 12:31:50 UTC (rev 71)
@@ -1,5 +1,6 @@
source('../R/functional.R')
source('../R/list.R')
+source('../R/string.R')
source('../R/parse.R')
FILE <- 'example-S3-mcpi.R'
More information about the Roxygen-commits
mailing list