[Roxygen-commits] r229 - in branches/manuel: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jun 23 17:56:41 CEST 2009
Author: manuel
Date: 2009-06-23 17:56:40 +0200 (Tue, 23 Jun 2009)
New Revision: 229
Added:
branches/manuel/R/Rdtank.R
Modified:
branches/manuel/R/Rd.R
branches/manuel/R/Rd_API.R
branches/manuel/R/parseS4.R
branches/manuel/sandbox/Rd2.R
branches/manuel/sandbox/example-S4-person.R
branches/manuel/sandbox/example-pseudoprime.R
Log:
Show methods with a specific class in the signature.
Modified: branches/manuel/R/Rd.R
===================================================================
--- branches/manuel/R/Rd.R 2009-06-22 14:37:57 UTC (rev 228)
+++ branches/manuel/R/Rd.R 2009-06-23 15:56:40 UTC (rev 229)
@@ -45,11 +45,9 @@
list(S4generic=car(expression)))
register.srcref.parser('setMethod',
- function(pivot, expression) {
- browser()
- list(S4method=car(expression),
- signature=cadr(expression))
- })
+ function(pivot, expression)
+ list(S4method=car(expression),
+ S4formals=parseS4.method(cdr(expression))))
#' Make an Rd roclet which parses the given files and, if specified, populates
#' the given subdirectory with Rd files; or writes to standard out. See
@@ -170,6 +168,9 @@
documentedonly=TRUE,
mergefn=Rd_merge) {
+ rdtank <- make.Rdtank()
+
+
saveRd <- TRUE
set.saveRd <- function()
@@ -186,7 +187,7 @@
save.Rd <- function() {
if ( saveRd )
- rdtank.add(rd, name, filename)
+ rdtank$add.Rd(rd, name, filename)
if ( verbose )
if ( saveRd )
@@ -317,7 +318,6 @@
environment())
if (verbose)
cat(sprintf('Processing %s:', name))
- #unlink(filename)
}
parse.expression('name', basename)
@@ -404,9 +404,16 @@
parse.examples(partitum)
if ( !is.null(partitum$S4class) ) {
+ rdtank$register.S4class(partitum$S4class, name)
+
parse.slots(partitum$S4formals)
parse.contains(partitum$S4formals)
}
+
+ if ( !is.null(partitum$S4method) ) {
+ rdtank$register.S4method(name, partitum$S4formals$signature,
+ partitum$description)
+ }
save.Rd()
reset.Rd()
@@ -420,19 +427,35 @@
reset.saveRd()
}
- post.files <- function() {
- for ( filename in rdtank.filenames() ) {
+ post.files.write <- function() {
+ for ( filename in rdtank$filenames() ) {
base <- baseRd(filename)
- final <- rdtank.get(filename)
-
+ final <- rdtank$get.Rd.by(filename=filename)
+
if ( length(final) > 1 || !is.null(base) )
final <- do.call('mergefn', list(final, base))
-
+
writeRd(final[[1]], filename)
}
+ }
- reset.rdtank()
+ post.files.classmethods <- function() {
+ for ( class in rdtank$classnames() ) {
+ if ( rdtank$class.exists(class) ) {
+ rd <- rdtank$get.Rd.by(classname=class)[[1]]
+ tag <- do.call('classmethodsTag',
+ lapply(rdtank$get.class.methods(class),
+ function(x) do.call('classmethodTag', x)))
+ rdtank$update.Rd(Rd_append_tag(rd, tag), classname=class)
+ }
+ }
}
+
+ post.files <- function() {
+ post.files.classmethods()
+ post.files.write()
+ rdtank$reset()
+ }
roclet <- make.roclet(parse.expression,
pre.parse,
@@ -580,28 +603,6 @@
roclet$register.parser('TODO', parse.todo)
-
- 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)
- }
-
- rdtank.get <- function(filename)
- roclet$rdtank$documents[roclet$rdtank$mergelist[[filename]]]
-
- rdtank.filenames <- function()
- names(roclet$rdtank$mergelist)
-
- reset.rdtank <- function() {
- roclet$rdtank$documents <- list()
- roclet$rdtank$mergelist <- list()
- }
-
baseRd <- function(filename)
if ( file.exists(filename) ) parse_Rd(filename) else NULL
Modified: branches/manuel/R/Rd_API.R
===================================================================
--- branches/manuel/R/Rd_API.R 2009-06-22 14:37:57 UTC (rev 228)
+++ branches/manuel/R/Rd_API.R 2009-06-23 15:56:40 UTC (rev 229)
@@ -16,13 +16,23 @@
}
containsTag <- function(..., x=list(...)) {
- return(sectionTag('Superclasses',
+ return(sectionTag('Extends',
list(textTag(paste('\\code{\\linkS4class{', x, '}}',
collapse=', ', sep='')))))
}
+classmethodTag <- function(name, signature, description) {
+ return(itemTag(name,
+ sprintf('\\code{signature(%s)}: %s',
+ paste(names(signature), dQuote(signature), sep=' = ', collapse=', '),
+ trim(description))))
+}
+classmethodsTag <- function(..., x=list(...)) {
+ return(sectionTag('Methods', list(describeTag(x))))
+}
+
### Rd tag elements:
nameTag <- function(x) {
Added: branches/manuel/R/Rdtank.R
===================================================================
--- branches/manuel/R/Rdtank.R (rev 0)
+++ branches/manuel/R/Rdtank.R 2009-06-23 15:56:40 UTC (rev 229)
@@ -0,0 +1,70 @@
+
+make.Rdtank <- function() {
+
+ tank <- new.env(parent=emptyenv())
+
+ tank$documents <- list()
+ tank$mergelist <- list()
+ tank$classmethods <- list()
+ tank$classlist <- list()
+
+ tank$add.Rd <- function(rd, name, filename=NULL) {
+ tank$documents[[name]] <- rd
+ if ( !is.null(filename) )
+ tank$mergelist[[filename]] <-
+ c(tank$mergelist[[filename]], name)
+
+ invisible(NULL)
+ }
+
+ tank$update.Rd <- function(rd, name=NULL, classname=NULL) {
+ if ( !is.null(name) )
+ tank$documents[[name]] <- rd
+ if ( !is.null(classname) )
+ tank$documents[[tank$classlist[[classname]]]] <- rd
+ }
+
+ tank$get.Rd.by <- function(name=NULL, filename=NULL, classname=NULL) {
+ if ( !is.null(name) )
+ return(tank$documents[name])
+ if ( !is.null(filename) )
+ return(tank$documents[tank$mergelist[[filename]]])
+ if ( !is.null(classname) )
+ return(tank$documents[tank$classlist[[classname]]])
+ }
+
+ tank$register.S4class <- function(classname, name)
+ tank$classlist[[classname]] <- name
+
+ tank$register.S4method <- function(name, signature, description) {
+ for ( class in signature )
+ tank$classmethods[[class]] <-
+ c(tank$classmethods[[class]],
+ list(list(name=name, signature=signature, description=description)))
+
+ invisible(NULL)
+ }
+
+ tank$filenames <- function()
+ names(tank$mergelist)
+
+ tank$classnames <- function()
+ names(tank$classmethods)
+
+ tank$class.exists <- function(class)
+ !is.null(tank$documents[[class]])
+
+ tank$get.class.methods <- function(class)
+ tank$classmethods[[class]]
+
+
+ tank$reset <- function() {
+ tank$documents <- list()
+ tank$mergelist <- list()
+ tank$classmethods <- list()
+ tank$classes <- list()
+ }
+
+ tank
+}
+
Modified: branches/manuel/R/parseS4.R
===================================================================
--- branches/manuel/R/parseS4.R 2009-06-22 14:37:57 UTC (rev 228)
+++ branches/manuel/R/parseS4.R 2009-06-23 15:56:40 UTC (rev 229)
@@ -1,12 +1,23 @@
+# NOTE: Most of the parsers require full specification, e.g.,
+# representation=representation(...) or signature=signature(object="numeric")
+
parseS4.class <- function(expression) {
formals <- list(representation=
cdr(preorder.flatten.expression(expression$representation)))
if ( !is.null(expression$contains) )
- formals <- append(formals, list(contains=expression$contains))
+ formals <- append(formals,
+ list(contains=expression$contains))
if ( !is.null(expression$prototype) )
formals <- append(formals,
list(prototype=
cdr(preorder.flatten.expression(expression$prototype))))
formals
}
+
+parseS4.method <- function(expression) {
+ formals <- list(signature=
+ cdr(preorder.flatten.expression(expression$signature)))
+
+ formals
+}
Modified: branches/manuel/sandbox/Rd2.R
===================================================================
--- branches/manuel/sandbox/Rd2.R 2009-06-22 14:37:57 UTC (rev 228)
+++ branches/manuel/sandbox/Rd2.R 2009-06-23 15:56:40 UTC (rev 229)
@@ -1,4 +1,6 @@
+setwd('Z:\\Projects\\Roxygen\\r-forge\\branches\\manuel\\sandbox')
+
# Roxygen base:
sources <- c('%s/R/roxygen.R',
'%s/R/functional.R',
@@ -19,13 +21,15 @@
# Changes:
library(tools)
-setwd('Z:\\Projects\\Roxygen\\r-forge\\branches\\manuel\\sandbox')
-
+source('../R/Rd_merge.R')
source('../R/Rd_API.R')
+source('../R/parseS4.R')
source('../R/Rd.R')
-source('../R/Rd_merge.R')
+
roc <- make.Rd.roclet(subdir='.')
+roc$parse('example-S4-person.R')
+
roc$parse('Bicycle.R')
roc$parse('example-pseudoprime.R')
@@ -33,6 +37,7 @@
+
### Benchmark package:
roxygenize2 <- function(package.dir,
@@ -107,7 +112,7 @@
rd <- Rd_append_tag(rd, nameTag("Manuel"))
rd <- Rd_append_tag(rd, aliasTag("Manuel"))
rd <- Rd_append_tag(rd, aliasTag("Eugster"))
-rd <- Rd_append_tag(rd, methodTag('do', 'x, a=1, b=2'))
+rd <- Rd_append_tag(rd, usageTag(methodTag('do', 'x, a=1, b=2')))
Modified: branches/manuel/sandbox/example-S4-person.R
===================================================================
--- branches/manuel/sandbox/example-S4-person.R 2009-06-22 14:37:57 UTC (rev 228)
+++ branches/manuel/sandbox/example-S4-person.R 2009-06-23 15:56:40 UTC (rev 229)
@@ -1,43 +1,50 @@
-# S4 documentation using Roxygen.
-
-
-
-#' This class represents a person.
-#'
-#' @slot fullname The full name of the person
-#' @slot birthyear The year of birth
-#' @prototype Prototype person is named John Doe
-#' and born in the year 1971
-#' @export
-setClass('Person',
- representation=
- representation(fullname='character',
- birthyear='numeric'),
- prototype=
- prototype(fullname='John Doe',
- birthyear=1971))
-
-#' Constructor function for Person object.
-#' @param fullname The name of the person.
-#' @param birthyear The year of birth.
-#' @returnType Person
-#' @return The Person object
-#' @export
-Person <- function(fullname, birthyear) {
- return(new('Person', fullname=fullname, birthyear=birthyear))
-}
-
-#' The naming of an object.
-#'
-#' @param object A object which gets a name
-setGeneric('name', function(object) standardGeneric('name'), valueClass='character')
-
-#' Name a person, the baptism.
-#'
-#' @param object A Person object
-#' @export
-setMethod('name', 'Person',
-function(object) {
- return(object at fullname)
-})
-
+# S4 documentation using Roxygen.
+
+
+
+#' This class represents a person.
+#' @slot fullname The full name of the person
+#' @slot birthyear The year of birth
+#' @export
+setClass('Person',
+ representation=
+ representation(fullname='character',
+ birthyear='numeric'),
+ prototype=
+ prototype(fullname='John Doe',
+ birthyear=1947),
+ contains='test')
+
+#' Constructor function for Person object.
+#' @param fullname The name of the person.
+#' @param birthyear The year of birth.
+#' @return The Person object
+#' @export
+Person <- function(fullname, birthyear) {
+ return(new('Person', fullname=fullname, birthyear=birthyear))
+}
+
+#' The naming of an object.
+#'
+#' @param object A object which gets a name
+setGeneric('name', function(object, y, ...) standardGeneric('name'), valueClass='character')
+
+#' Name a person, the baptism.
+#'
+#' @param object A Person object
+#' @export
+setMethod('name', signature=signature(object='Person', y='numeric'),
+function(object, y, ...) {
+ return(object at fullname)
+})
+
+#' Blub a person.
+#'
+#' @param object A Person object
+#' @export
+setMethod('blub', signature=signature(object='Person', y='character'),
+function(object, y, ...) {
+ return(object at fullname)
+})
+
+
Modified: branches/manuel/sandbox/example-pseudoprime.R
===================================================================
--- branches/manuel/sandbox/example-pseudoprime.R 2009-06-22 14:37:57 UTC (rev 228)
+++ branches/manuel/sandbox/example-pseudoprime.R 2009-06-23 15:56:40 UTC (rev 229)
@@ -11,7 +11,6 @@
#' 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
@@ -37,7 +36,6 @@
#' @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)
More information about the Roxygen-commits
mailing list