[Roxygen-commits] r221 - in branches/manuel: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri May 29 17:18:44 CEST 2009
Author: manuel
Date: 2009-05-29 17:18:44 +0200 (Fri, 29 May 2009)
New Revision: 221
Modified:
branches/manuel/R/Rd.R
branches/manuel/R/Rd_API.R
branches/manuel/R/Rd_merge.R
branches/manuel/R/roxygenize.R
branches/manuel/sandbox/Rd2.R
branches/manuel/sandbox/example-pseudoprime.R
Log:
Rd roclet with a new workflow: in a first step, all Rd structures are created and collected in an environment, and a merge list is built. In a second step the Rd structures are merged and written to the corresponding files.
Modified: branches/manuel/R/Rd.R
===================================================================
--- branches/manuel/R/Rd.R 2009-05-29 06:54:02 UTC (rev 220)
+++ branches/manuel/R/Rd.R 2009-05-29 15:18:44 UTC (rev 221)
@@ -165,7 +165,6 @@
mergefn=Rd_merge,
exportonly=FALSE,
debug=FALSE) {
-
writeRd <- TRUE
set.writeRd <- function()
@@ -176,17 +175,18 @@
reset.writeRd <- function()
set.writeRd()
-
rd <- Rd()
write.Rd <- function() {
if ( writeRd ) {
- if ( !debug )
- cat(tools:::as.character.Rd(rd),
- sep='', collapse='\n', file=filename)
- else
- save(rd, file=paste(filename, 'Rdata', sep='.'))
+ #if ( !debug )
+ # cat(tools:::as.character.Rd(rd),
+ # sep='', collapse='\n', file=filename)
+ #else
+ # save(rd, file=paste(filename, 'Rdata', sep='.'))
+
+ rdtank.add(rd, name, filename)
}
if ( verbose )
@@ -242,6 +242,7 @@
filename <- ''
+ name <- ''
reset.filename <- function()
assign.parent('filename', '', environment())
@@ -338,9 +339,11 @@
cat(sprintf('Processing %s:', name))
#unlink(filename)
}
-
+
parse.expression('name', basename)
parse.expression('alias', name)
+
+ assign.parent('name', name, environment())
}
if ((!is.null(name) || !is.null(partitum$title)) &&
!is.null(title <- parse.title(partitum, name)))
@@ -421,8 +424,8 @@
parse.arguments()
parse.examples(partitum)
- if ( file.exists(filename) )
- merge.Rd(existing.Rd())
+ #if ( file.exists(filename) )
+ # merge.Rd(existing.Rd())
write.Rd()
reset.Rd()
@@ -521,7 +524,7 @@
parse.arguments <- function()
if (length(params) > 0)
#parse.expression('\\arguments', parse.params())
- append.Rd(argumentsTag(x=parse.params()))
+ append.Rd(argumentsTag(x=parse.params(), newline=TRUE))
roclet$register.parser('param', parse.param)
@@ -563,5 +566,32 @@
roclet$register.parser('TODO', parse.todo)
+
+ ### Rd tank:
+ roclet$rdtank <- new.env(parent=emptyenv())
+ roclet$rdtank$documents <- list()
+ roclet$rdtank$mergelist <- list()
+
+ rdtank.add <- function(rd, name, filename) {
+ roclet$rdtank$documents[[name]] <- rd
+ roclet$rdtank$mergelist[[filename]] <-
+ c(roclet$rdtank$mergelist[[filename]], name)
+ }
+
+ roclet$write <- function() {
+ for ( filename in names(roclet$rdtank$mergelist) ) {
+
+ base <- if ( file.exists(filename) ) parse_Rd(filename) else NULL
+ final <- roclet$rdtank$documents[roclet$rdtank$mergelist[[filename]]]
+
+ if ( length(final) > 1 || !is.null(base) )
+ final <- do.call('mergefn', list(final, base))
+
+ #rdtank.add(final, paste(filename, '2', sep=''), '1')
+ cat(tools:::as.character.Rd(final[[1]]),
+ sep='', collapse='\n', file=filename)
+ }
+ }
+
roclet
}
Modified: branches/manuel/R/Rd_API.R
===================================================================
--- branches/manuel/R/Rd_API.R 2009-05-29 06:54:02 UTC (rev 220)
+++ branches/manuel/R/Rd_API.R 2009-05-29 15:18:44 UTC (rev 221)
@@ -30,7 +30,10 @@
list(textTag(y))), '\\item'))
}
-argumentsTag <- function(..., x=list(...)) {
+argumentsTag <- function(..., x=list(...), newline=FALSE) {
+ if ( newline )
+ x <- newlineSeperators(x)
+
return(Rd_tag(x, '\\arguments'))
}
@@ -47,6 +50,15 @@
return(textTag('\n'))
}
+newlineSeperators <- function(x) {
+ l <- 2 * length(x)
+
+ t <- vector('list', length=l)
+ t[seq(1, l, by=2)] <- x
+ t[seq(2, l, by=2)] <- newlineTag()
+
+ return(t)
+}
### Basic tag elements:
Modified: branches/manuel/R/Rd_merge.R
===================================================================
--- branches/manuel/R/Rd_merge.R 2009-05-29 06:54:02 UTC (rev 220)
+++ branches/manuel/R/Rd_merge.R 2009-05-29 15:18:44 UTC (rev 221)
@@ -1,85 +1,69 @@
-Rd_merge <- function(x, y, appenders=simpleappenders(), mergers=simplemergers()) {
- # x is the base Rd, all tags from y are merged into x.
+Rd_merge <- function(rdlist, base=Rd(), mergefn=merge.Rd) {
+ for ( rd in names(rdlist) )
+ base <- mergefn(base, rdlist[[rd]], yname=rd)
+ return(list(base))
+}
+
+merge.Rd <- function(x, y, yname=NULL, mergers=simplemergers(), ...) {
+ # NOTE: x is the base rd.
+
getMerger <- function(name)
if ( !is.null(mergers[[name]]) ) mergers[[name]] else mergers$DEFAULT
- getAppender <- function(name)
- if ( !is.null(appenders[[name]]) ) appenders[[name]] else appenders$DEFAULT
-
- yname <- unlist(y[[which(sapply(y, attr, 'Rd_tag') == '\\alias')[1]]])
-
MULTIPLE <- c('\\alias', '\\keyword')
-
+
xtagnames <- tools:::RdTags(x)
ytagnames <- tools:::RdTags(y)
-
+
for ( yat in which(ytagnames != 'TEXT') ) {
ytagname <- ytagnames[yat]
ytag <- y[[yat]]
xat <- NULL
-
- if ( !(ytagname %in% MULTIPLE) ) {
- if ( ytagname %in% xtagnames ) {
+
+ if ( !(ytagname %in% MULTIPLE) ) {
+ if ( ytagname %in% xtagnames )
xat <- which(xtagnames == ytagname)
- merger <- getMerger(substring(ytagname, 2))
-
- ytag <- merger(x[[xat]], ytag, yname)
- }
+
+ merger <- getMerger(substring(ytagname, 2))
+ ytag <- merger(if (is.null(xat)) NULL else x[[xat]], ytag, yname)
}
- #x <- Rd_append_tag(x, ytag, xat)
- appender <- getAppender(substring(ytagname, 2))
- x <- appender(x, ytag, xat, yname)
+ x <- Rd_append_tag(x, ytag, xat)
}
return(x)
}
-
-
-### Appender:
-
-simpleappenders <- function() {
- return(list(DEFAULT=default.appender,
- value=value.appender))
-}
-
-default.appender <- function(x, y, at, name) {
- return(Rd_append_tag(x, y, at))
-}
-
-value.appender <- function(x, y, at, name) {
- x <- Rd_tag_append_tag(x, textTag(sprintf('\\code{%s}:', name)))
- return(Rd_append_tag(x, y))
-}
-
-
-
-### Merger:
-
simplemergers <- function() {
return(list(DEFAULT=default.merger,
name=omity.merger,
description=omity.merger,
author=omity.merger,
title=omity.merger,
- value=value.merger,
+ value=paragraph.merger,
+ description=paragraph.merger,
arguments=arguments.merger))
}
-default.merger <- function(x, y, name) {
+default.merger <- function(x, y, yname) {
+ if ( is.null(x) )
+ return(y)
+
return(Rd_tag_append_tag(x, y))
}
-omity.merger <- function(x, y, name) {
+omity.merger <- function(x, y, yname) {
return(x)
}
arguments.merger <- function(x, y, name) {
+ if ( is.null(x) )
+ return(y)
+
attr <- attributes(x)
xitems <- unlist(sapply(x, '[[', 1))
@@ -93,6 +77,15 @@
return(x)
}
-value.merger <- function(x, y, name) {
- return(Rd_tag_append_tag(x, y))
+paragraph.merger <- function(x, y, yname) {
+ t <- textTag(sprintf('\\emph{%s}: ', yname))
+ attr <- attributes(y)
+ y <- c(t, y, newlineTag(), newlineTag())
+ attributes(y) <- attr
+
+ if ( is.null(x) )
+ return(y)
+
+ return(Rd_tag_append_tag(x, y))
}
+
Modified: branches/manuel/R/roxygenize.R
===================================================================
--- branches/manuel/R/roxygenize.R 2009-05-29 06:54:02 UTC (rev 220)
+++ branches/manuel/R/roxygenize.R 2009-05-29 15:18:44 UTC (rev 221)
@@ -1,122 +1,123 @@
-#' @include roxygen.R
-#' @include Rd.R
-#' @include namespace.R
-#' @include collate.R
-roxygen()
-
-#' Whither to copy package
-ROXYGEN.DIR <- '%s.roxygen'
-
-#' Whither to copy Rds
-MAN.DIR <- 'man'
-
-#' Whither to copy installables
-INST.DIR <- 'inst'
-
-#' Whither to install docs
-DOC.DIR <- 'doc'
-
-#' Whence to copy source code
-R.DIR <- 'R'
-
-#' Whither to copy namespace
-NAMESPACE.FILE <- 'NAMESPACE'
-
-#' Whither to copy collate
-DESCRIPTION.FILE <- 'DESCRIPTION'
-
-#' Recursively copy a directory thither; optionally unlinking
-#' the target first; optionally overwriting; optionally
-#' verbalizing.
-#' @param source the source directory
-#' @param target the target directory
-#' @param unlink.target delete target directory first?
-#' @param overwrite overwrite target files?
-#' @param verbose verbalize transaction?
-#' @return \code{NULL}
-#' @note Not tested on non-linux platforms
-copy.dir <- function(source,
- target,
- unlink.target=FALSE,
- overwrite=FALSE,
- verbose=FALSE) {
- if (unlink.target)
- unlink(target, recursive=TRUE)
- files <- list.files(source,
- full.name=TRUE,
- recursive=TRUE,
- all.files=TRUE)
- for (source.file in files) {
- promoted.file <- sub('[^/\\]*(/|\\\\)', '', source.file)
- target.file <- file.path(target, promoted.file)
- target.dir <- dirname(target.file)
- ## Could create, instead, a list of unique directories in
- ## Theta(n).
- dir.create(target.dir, recursive=TRUE, showWarnings=FALSE)
- if (verbose)
- cat(sprintf('%s -> %s', source.file, target.file), '\n')
- file.copy(source.file, target.file, overwrite=overwrite)
- }
-}
-
-#' Process a package with the Rd, namespace and collate roclets.
-#' @param package.dir the package's top directory
-#' @param roxygen.dir whither to copy roxygen files; defaults to
-#' \file{package.roxygen}.
-#' @param copy.package copies the package over before
-#' adding/manipulating files.
-#' @param overwrite overwrite target files
-#' @param unlink.target unlink target directory before
-#' processing files
-#' @return \code{NULL}
-#' @callGraph
-#' @callGraphDepth 1
-#' @TODO Options to enable/disable specific roclet
-#' (\command{--no-callgraphs}, etc.)
-#' @export
-roxygenize <- function(package.dir,
- roxygen.dir=NULL,
- copy.package=TRUE,
- overwrite=TRUE,
- unlink.target=FALSE) {
- if (is.null(roxygen.dir)) roxygen.dir <-
- sprintf(ROXYGEN.DIR, package.dir)
- man.dir <- file.path(roxygen.dir, MAN.DIR)
- inst.dir <- file.path(roxygen.dir, INST.DIR)
- doc.dir <- file.path(inst.dir, DOC.DIR)
- namespace.file <- file.path(roxygen.dir, NAMESPACE.FILE)
- package.description <- file.path(package.dir, DESCRIPTION.FILE)
- roxygen.description <- file.path(roxygen.dir, DESCRIPTION.FILE)
- skeleton <- c(roxygen.dir,
- man.dir,
- doc.dir)
-
- if (copy.package)
- copy.dir(package.dir,
- roxygen.dir,
- unlink.target=unlink.target,
- overwrite=overwrite,
- verbose=FALSE)
-
- for (dir in skeleton) dir.create(dir,
- recursive=TRUE,
- showWarnings=FALSE)
- r.dir <- file.path(package.dir, R.DIR)
- files <- as.list(list.files(r.dir,
- pattern='\\.(R|r)$',
- recursive=TRUE,
- full.names=TRUE,
- all.files=TRUE))
- Rd <- make.Rd.roclet(man.dir)
- do.call(Rd$parse, files)
- namespace <- make.namespace.roclet(namespace.file)
- do.call(namespace$parse, files)
- collate <- make.collate.roclet(merge.file=package.description,
- target.file=roxygen.description)
- collate$parse.dir(r.dir)
- callgraph <-
- make.callgraph.roclet(description.dependencies(package.description),
- doc.dir)
- do.call(callgraph$parse, files)
-
-}
+#' @include roxygen.R
+#' @include Rd.R
+#' @include namespace.R
+#' @include collate.R
+roxygen()
+
+#' Whither to copy package
+ROXYGEN.DIR <- '%s.roxygen'
+
+#' Whither to copy Rds
+MAN.DIR <- 'man'
+
+#' Whither to copy installables
+INST.DIR <- 'inst'
+
+#' Whither to install docs
+DOC.DIR <- 'doc'
+
+#' Whence to copy source code
+R.DIR <- 'R'
+
+#' Whither to copy namespace
+NAMESPACE.FILE <- 'NAMESPACE'
+
+#' Whither to copy collate
+DESCRIPTION.FILE <- 'DESCRIPTION'
+
+#' Recursively copy a directory thither; optionally unlinking
+#' the target first; optionally overwriting; optionally
+#' verbalizing.
+#' @param source the source directory
+#' @param target the target directory
+#' @param unlink.target delete target directory first?
+#' @param overwrite overwrite target files?
+#' @param verbose verbalize transaction?
+#' @return \code{NULL}
+#' @note Not tested on non-linux platforms
+copy.dir <- function(source,
+ target,
+ unlink.target=FALSE,
+ overwrite=FALSE,
+ verbose=FALSE) {
+ if (unlink.target)
+ unlink(target, recursive=TRUE)
+ files <- list.files(source,
+ full.name=TRUE,
+ recursive=TRUE,
+ all.files=TRUE)
+ for (source.file in files) {
+ promoted.file <- sub('[^/\\]*(/|\\\\)', '', source.file)
+ target.file <- file.path(target, promoted.file)
+ target.dir <- dirname(target.file)
+ ## Could create, instead, a list of unique directories in
+ ## Theta(n).
+ dir.create(target.dir, recursive=TRUE, showWarnings=FALSE)
+ if (verbose)
+ cat(sprintf('%s -> %s', source.file, target.file), '\n')
+ file.copy(source.file, target.file, overwrite=overwrite)
+ }
+}
+
+#' Process a package with the Rd, namespace and collate roclets.
+#' @param package.dir the package's top directory
+#' @param roxygen.dir whither to copy roxygen files; defaults to
+#' \file{package.roxygen}.
+#' @param copy.package copies the package over before
+#' adding/manipulating files.
+#' @param overwrite overwrite target files
+#' @param unlink.target unlink target directory before
+#' processing files
+#' @return \code{NULL}
+#' @callGraph
+#' @callGraphDepth 1
+#' @TODO Options to enable/disable specific roclet
+#' (\command{--no-callgraphs}, etc.)
+#' @export
+roxygenize <- function(package.dir,
+ roxygen.dir=NULL,
+ copy.package=TRUE,
+ overwrite=TRUE,
+ unlink.target=FALSE) {
+ if (is.null(roxygen.dir)) roxygen.dir <-
+ sprintf(ROXYGEN.DIR, package.dir)
+ man.dir <- file.path(roxygen.dir, MAN.DIR)
+ inst.dir <- file.path(roxygen.dir, INST.DIR)
+ doc.dir <- file.path(inst.dir, DOC.DIR)
+ namespace.file <- file.path(roxygen.dir, NAMESPACE.FILE)
+ package.description <- file.path(package.dir, DESCRIPTION.FILE)
+ roxygen.description <- file.path(roxygen.dir, DESCRIPTION.FILE)
+ skeleton <- c(roxygen.dir,
+ man.dir,
+ doc.dir)
+
+ if (copy.package)
+ copy.dir(package.dir,
+ roxygen.dir,
+ unlink.target=unlink.target,
+ overwrite=overwrite,
+ verbose=FALSE)
+
+ for (dir in skeleton) dir.create(dir,
+ recursive=TRUE,
+ showWarnings=FALSE)
+ r.dir <- file.path(package.dir, R.DIR)
+ files <- as.list(list.files(r.dir,
+ pattern='\\.(R|r)$',
+ recursive=TRUE,
+ full.names=TRUE,
+ all.files=TRUE))
+ Rd <- make.Rd.roclet(man.dir)
+ do.call(Rd$parse, files)
+ Rd$write()
+ namespace <- make.namespace.roclet(namespace.file)
+ do.call(namespace$parse, files)
+ collate <- make.collate.roclet(merge.file=package.description,
+ target.file=roxygen.description)
+ collate$parse.dir(r.dir)
+ callgraph <-
+ make.callgraph.roclet(description.dependencies(package.description),
+ doc.dir)
+ do.call(callgraph$parse, files)
+
+}
Modified: branches/manuel/sandbox/Rd2.R
===================================================================
--- branches/manuel/sandbox/Rd2.R 2009-05-29 06:54:02 UTC (rev 220)
+++ branches/manuel/sandbox/Rd2.R 2009-05-29 15:18:44 UTC (rev 221)
@@ -25,7 +25,14 @@
source('../R/Rd.R')
source('../R/Rd_merge.R')
+roc <- make.Rd.roclet(subdir='.')
+roc$parse('example-pseudoprime.R')
+
+
+
+### Benchmark package:
+
roxygenize2 <- function(package.dir,
roxygen.dir=NULL,
copy.package=TRUE,
@@ -61,6 +68,8 @@
all.files=TRUE))
Rd <- make.Rd.roclet(man.dir)
do.call(Rd$parse, files)
+ Rd$write()
+
namespace <- make.namespace.roclet(namespace.file)
do.call(namespace$parse, files)
collate <- make.collate.roclet(merge.file=package.description,
@@ -70,11 +79,13 @@
# make.callgraph.roclet(description.dependencies(package.description),
# doc.dir)
#do.call(callgraph$parse, files)
+
+ return(Rd)
}
setwd('Z:/Research/Benchmarking')
-roxygenize2('pkg', roxygen.dir='builds/benchmark')
+r <- roxygenize2('pkg', roxygen.dir='builds/benchmark')
r <- parse_Rd('builds/benchmark/man/basicplots.Rd')
r <- parse_Rd('builds/benchmark/man/bench-class.Rd')
Modified: branches/manuel/sandbox/example-pseudoprime.R
===================================================================
--- branches/manuel/sandbox/example-pseudoprime.R 2009-05-29 06:54:02 UTC (rev 220)
+++ branches/manuel/sandbox/example-pseudoprime.R 2009-05-29 15:18:44 UTC (rev 221)
@@ -1,44 +1,45 @@
-#' Test an integer for primality with Fermat's Little Theorem.
-#'
-#' Fermat's Little Theorem states that if \eqn{n} is a prime
-#' number and \eqn{a} is any positive integer less than \eqn{n},
-#' then \eqn{a} raised to the \eqn{n}th power is congruent to
-#' \eqn{a modulo n}.
-#'
-#' @author Peter Danenberg \email{pcd@@roxygen.org}
-#' @param n the integer to test for primality
-#' @return Whether the integer passes the Fermat test
-#' for a randomized \eqn{0 < a < n}
-#' @note \code{fermat.test} doesn't work for integers above
-#' approximately fifteen because modulus loses precision.
-#' @rdname fermat
-fermat.test <- function(n) {
- a <- floor(runif(1, min=1, max=n))
- a ^ n %% n == a
-}
-
-#' Check an integer for pseudo-primality to an arbitrary
-#' precision.
-#'
-#' A number is pseudo-prime if it is probably prime, the basis
-#' of which is the probabilistic Fermat test; if it passes two
-#' such tests, the chances are better than 3 out of 4 that
-#' \eqn{n} is prime.
-#'
-#' @author Peter Danenberg \email{pcd@@roxygen.org}
-#' @param n the integer to test for pseudoprimality.
-#' @param times the number of Fermat tests to perform
-#' @return Whether the number is pseudoprime
-#' @export
-#' @seealso \code{\link{fermat.test}}
-#' @references Abelson, Hal; Jerry Sussman, and Julie Sussman.
-#' Structure and Interpretation of Computer Programs.
-#' Cambridge: MIT Press, 1984.
-#' @keywords pseudoprime fermat
-#' @examples
-#' is.pseudoprime(13, 4) # TRUE most of the time
-is.pseudoprime <- function(n, times) {
- if (times == 0) TRUE
- else if (fermat.test(n)) is.pseudoprime(n, times - 1)
- else FALSE
-}
+#' Test an integer for primality with Fermat's Little Theorem.
+#'
+#' Fermat's Little Theorem states that if \eqn{n} is a prime
+#' number and \eqn{a} is any positive integer less than \eqn{n},
+#' then \eqn{a} raised to the \eqn{n}th power is congruent to
+#' \eqn{a modulo n}.
+#'
+#' @author Peter Danenberg \email{pcd@@roxygen.org}
+#' @param n the integer to test for primality
+#' @return Whether the integer passes the Fermat test
+#' for a randomized \eqn{0 < a < n}
+#' @note \code{fermat.test} doesn't work for integers above
+#' approximately fifteen because modulus loses precision.
+#' @rdname fermat
+fermat.test <- function(n) {
+ a <- floor(runif(1, min=1, max=n))
+ a ^ n %% n == a
+}
+
+#' Check an integer for pseudo-primality to an arbitrary
+#' precision.
+#'
+#' A number is pseudo-prime if it is probably prime, the basis
+#' of which is the probabilistic Fermat test; if it passes two
+#' such tests, the chances are better than 3 out of 4 that
+#' \eqn{n} is prime.
+#'
+#' @author Peter Danenberg \email{pcd@@roxygen.org}
+#' @param n the integer to test for pseudoprimality.
+#' @param times the number of Fermat tests to perform
+#' @return Whether the number is pseudoprime
+#' @export
+#' @seealso \code{\link{fermat.test}}
+#' @references Abelson, Hal; Jerry Sussman, and Julie Sussman.
+#' Structure and Interpretation of Computer Programs.
+#' Cambridge: MIT Press, 1984.
+#' @keywords pseudoprime fermat
+#' @examples
+#' is.pseudoprime(13, 4) # TRUE most of the time
+#' @rdname fermat
+is.pseudoprime <- function(n, times) {
+ if (times == 0) TRUE
+ else if (fermat.test(n)) is.pseudoprime(n, times - 1)
+ else FALSE
+}
More information about the Roxygen-commits
mailing list