[Roxygen-commits] r51 - in pkg: R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jul 19 23:06:21 CEST 2008
Author: pcd
Date: 2008-07-19 23:06:21 +0200 (Sat, 19 Jul 2008)
New Revision: 51
Added:
pkg/R/string.R
Modified:
pkg/R/Rd.R
pkg/R/parse.R
pkg/sandbox/Rd.R
pkg/sandbox/example-Rd-nlm.R
Log:
slow, not-quite-working strcar, strcdr implementation (no tokenizing)
Modified: pkg/R/Rd.R
===================================================================
--- pkg/R/Rd.R 2008-07-19 21:04:55 UTC (rev 50)
+++ pkg/R/Rd.R 2008-07-19 21:06:21 UTC (rev 51)
@@ -1,4 +1,4 @@
-#' @include list.R
+#' @include list.R string.R functional.R
Rd <- function(partita) {
relevators <- c('name',
'aliases',
@@ -40,21 +40,33 @@
parse.concept <- Curry(parse.default, key='concept')
- parse.split <- function(key, expressions)
- for (expression in strsplit(expressions, SPACE))
- parse.default(key, expression)
+ parse.split <- function(key, expressions) {
+ expression <- strcar(expressions)
+ rest <- strcdr(expressions)
+ parse.default(key, expression)
+ if (!is.null.string(rest))
+ parse.split(key, rest)
+ }
parse.keywords <- Curry(parse.split, key='keyword')
parse.aliases <- Curry(parse.split, key='alias')
parse.description <- function(expressions) {
+ paragraphs <- car(strsplit(expressions, '\n\n', fixed=T))
+ description <- car(paragraphs)
+ details <- do.call(paste, list(cdr(paragraphs), sep='\n\n'))
print(expressions)
- paragraphs <- strsplit(expressions, '\n\n', fixed=T)
- description <- car(paragraphs)
- details <- do.call(paste, c(cdr(paragraphs), sep='\n\n'))
+### matter <- '[^\n]+'
+### words <- Curry(words.default, matter=matter)
+### nwords <- Curry(nwords.default, words=words)
+### word.ref <- Curry(word.ref.default, words=words)
+### strcar <- Curry(strcar.default, word.ref=word.ref)
+### strcdr <- Curry(strcdr.default, nwords=nwords, word.ref=word.ref)
+### description <- strcar(expressions)
+### details <- strcdr(expressions)
parse.default('description', description)
- if (Negate(is.nil)(details))
+ if (!is.null.string(details))
parse.default('details', details)
}
Modified: pkg/R/parse.R
===================================================================
--- pkg/R/parse.R 2008-07-19 21:04:55 UTC (rev 50)
+++ pkg/R/parse.R 2008-07-19 21:06:21 UTC (rev 51)
@@ -2,10 +2,6 @@
LINE.DELIMITER <- '#\' '
TAG.DELIMITER <- '@'
-paste.list <- function(list) {
- do.call(paste, c(list, sep="\n"))
-}
-
#' Comment blocks (possibly null) that precede a file's expressions.
prerefs <- function(srcfile, srcrefs) {
length.line <- function(lineno)
@@ -38,36 +34,32 @@
warning(parse.message(key, message))
parse.element <- function(element) {
- tokens <- car(strsplit(element, SPACE))
- parser <- parser.preref(car(tokens))
- do.call(parser, as.list(cdr(tokens)))
+ tag <- strcar(element)
+ rest <- strcdr(element)
+ parser <- parser.preref(tag)
+ do.call(parser, list(rest))
}
parse.description <- function(expression)
list(description=expression)
-is.empty <- function(...) is.nil(c(...)) || is.na(car(as.list(...)))
+parse.default <- function(key, rest)
+ as.list(structure(rest, names=key))
-args.to.string <- function(...)
- ifelse(is.empty(...), NA, paste(...))
-
-parse.default <- function(key, ...)
- as.list(structure(args.to.string(...), names=key))
-
-parse.preref <- function(key, ...) {
+parse.preref <- function(key, rest) {
parse.warning(sprintf('<%s>', key), 'is an unknown key')
- parse.default(key, ...)
+ parse.default(key, rest)
}
## Possibly NA; in which case, the Roclets can do something more
## sophisticated with the srcref.
parse.export <- Curry(parse.default, key='export')
-parse.value <- function(key, ...) {
- if (is.empty(...))
+parse.value <- function(key, rest) {
+ if (is.null.string(rest))
parse.error(key, 'requires a value')
else
- parse.default(key, ...)
+ parse.default(key, rest)
}
parse.prototype <- Curry(parse.value, key='prototype')
@@ -114,13 +106,14 @@
parse.author <- Curry(parse.value, key='author')
-parse.name.description <- function(key, name, ...) {
- if (any(is.na(name),
- is.empty(...)))
+parse.name.description <- function(key, rest) {
+ name <- strcar(rest)
+ rest <- strcdr(rest)
+ if (is.null.string(name))
parse.error(key, 'requires a name and description')
else
as.list(structure(list(list(name=name,
- description=args.to.string(...))),
+ description=rest)),
names=key))
}
@@ -128,19 +121,17 @@
parse.param <- Curry(parse.name.description, key='param')
-parse.name.internal <- function(key, name, ...) {
- if (is.na(name))
+parse.name.internal <- function(key, name) {
+ if (is.null.string(name))
parse.error(key, 'requires a name')
- else if (Negate(is.empty)(...))
- parse.warning(key, 'discards extra-nominal entries')
- parse.default(key, name)
+ parse.default(key, strcar(name))
}
parse.S3class <- Curry(parse.name.internal, key='S3class')
parse.returnType <- Curry(parse.name.internal, key='returnType')
-parse.toggle <- function(key, ...)
+parse.toggle <- function(key, rest)
as.list(structure(T, names=key))
parse.listObject <- Curry(parse.toggle, key='listObject')
@@ -192,14 +183,12 @@
trimmed.lines <-
Map(function(line) substr(line, nchar(LINE.DELIMITER) + 1, nchar(line)),
delimited.lines)
- ## Presumption: white-space is insignificant.
-### joined.lines <- gsub(' {2,}', ' ', paste.list(trimmed.lines))
- joined.lines <- paste.list(trimmed.lines)
+ joined.lines <- do.call(paste, c(trimmed.lines, sep='\n'))
if (is.nil(joined.lines))
nil
else {
### print(joined.lines)
- elements <- Map(trim, car(strsplit(joined.lines, TAG.DELIMITER, fixed=T)))
+ elements <- car(strsplit(joined.lines, TAG.DELIMITER, fixed=T))
### elements <- car(strsplit(joined.lines, TAG.DELIMITER, fixed=T))
### print(str(elements))
description <- car(elements)
Added: pkg/R/string.R
===================================================================
--- pkg/R/string.R (rev 0)
+++ pkg/R/string.R 2008-07-19 21:06:21 UTC (rev 51)
@@ -0,0 +1,55 @@
+#' @include functional.R
+SPACE <- '[[:space:]]+'
+MATTER <- '[^[:space:]]+'
+
+trim.left <- function(string)
+ gsub(sprintf('^%s', SPACE), '', string)
+
+trim.right <- function(string)
+ gsub(sprintf('%s$', SPACE), '', string)
+
+trim <- function(string)
+ Compose(trim.left, trim.right)(string)
+
+is.null.string <- function(string) regexpr(MATTER, string) < 0
+
+## Major source of inefficiency; resort to a words-string datatype
+## with pre-delineated words?
+words.default <- function(string, matter) gregexpr(matter, string)[[1]]
+
+nwords.default <- function(string, words) length(words(string))
+
+word.ref.default <- function(string, n, words) {
+ words <- words(string)
+ start <- words[[n]]
+ length <- attributes(words)$match.length[[n]]
+ end <- start + length - 1
+ list(start=start, end=end)
+}
+
+strcar.default <- function(string, word.ref) {
+ if (is.null.string(string))
+ stop('CARing null-string')
+ ref <- word.ref(string, 1)
+ substr(string, ref$start, ref$end)
+}
+
+strcdr.default <- function(string, nwords, word.ref) {
+ if (is.null.string(string))
+ stop('CDRing null-string')
+ nwords <- nwords(string)
+ if (nwords == 1)
+ ''
+ else
+ substr(string, word.ref(string, 2)$start, nchar(string))
+}
+
+words <- Curry(words.default, matter=MATTER)
+
+nwords <- Curry(nwords.default, words=words)
+
+word.ref <- Curry(word.ref.default, words=words)
+
+strcar <- Curry(strcar.default, word.ref=word.ref)
+
+strcdr <- Curry(strcdr.default, nwords=nwords, word.ref=word.ref)
Modified: pkg/sandbox/Rd.R
===================================================================
--- pkg/sandbox/Rd.R 2008-07-19 21:04:55 UTC (rev 50)
+++ pkg/sandbox/Rd.R 2008-07-19 21:06:21 UTC (rev 51)
@@ -1,6 +1,7 @@
source('../R/functional.R')
source('../R/list.R')
source('../R/parse.R')
+source('../R/strings.R')
source('../R/Rd.R')
FILE <- 'example-Rd-nlm.R'
Modified: pkg/sandbox/example-Rd-nlm.R
===================================================================
--- pkg/sandbox/example-Rd-nlm.R 2008-07-19 21:04:55 UTC (rev 50)
+++ pkg/sandbox/example-Rd-nlm.R 2008-07-19 21:06:21 UTC (rev 51)
@@ -3,7 +3,7 @@
#'
#'
#' Note that arguments after \code{\dots} must be matched exactly.
-#'
+#'
#' If a gradient or hessian is supplied but evaluates to the wrong mode
#' or length, it will be ignored if \code{check.analyticals = TRUE} (the
#' default) with a warning. The hessian is not even checked unless the
More information about the Roxygen-commits
mailing list