[Rd] promptFunctions() to handle multiple names

From: Daniel Sabanés Bové <daniel.sabanesbove_at_campus.lmu.de>
Date: Sun, 13 Apr 2008 16:52:43 +0200


-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA512

Hi all,

I wanted to set up my first (private) R-package and wondered if there was a function to prompt() for multiple aliases in one Rd-file, e.g. to create something like the normal distribution manual page encompassing rnorm, dnorm,...

As I didn't find it, I modified prompt.default() and wrote a small function to do this job, called "promptFunctions". It basically calls the helper ".promptFunction" for every name it gets and puts together the output from each function.

It would be interesting for me if such a function already existed in R or if something like "promptFunction" could be included in any future R version.
I think it would be used as many man pages document several functions at once,
and cutting and pasting the single prompt() files by hand could be boring.

regards,
Daniel

The Code:

## modified prompt.default to handle multiple functions correctly promptFunctions <-
~ function (..., # objects to be documented
~ filename = NULL, # file name string or NA for
console
~ names = NULL, # character vector of object names
~ rdname = NULL, # name of the documentation
~ overwrite = FALSE # overwrite existing Rd file?
~ )

{
~ ## helper functions
~ paste0 <- function(...) paste(..., sep = "")
~ is.missing.arg <- function(arg) typeof(arg) == "symbol" &&
~ deparse(arg) == ""

~ ## generate additional names from objects
~ objects <- as.list (substitute (...[]))
~ objects <- objects[seq(from = 2, to = length(objects) - 1)]
~ objects <- sapply(objects, deparse)

~ ## merge with names from call and stop if there are no usable names
~ names <- unique(c(objects, names))
~ if (is.null(names))
~ stop ("cannot determine usable names")

~ ## determine Rd name
~ if(is.null(rdname))
~ rdname <- names[1]

~ ## determine file name
~ if (is.null(filename))
~ filename <- paste0(rdname, ".Rd")

~ ## treat each name individually
~ promptList <- lapply(names, .promptFunction)
~ names(promptList) <- names

~ ## construct text
~ Rdtxt <- list()

~ Rdtxt$name <- paste0("\\name{", rdname, "}")
~ Rdtxt$aliases <- c(paste0("\\alias{", names, "}"),
~ paste("%- Also NEED an '\\alias' for EACH other
topic",
~ "documented here."))
~ Rdtxt$title <- "\\title{ ~~functions to do ... ~~ }"
~ Rdtxt$description <- c("\\description{",
~ paste(" ~~ A concise (1-5 lines)
description of what",
~ "the functions"),
~ paste(" ", paste(names, collapse = ", "),
~ "do. ~~"),
~ "}")
~ Rdtxt$usage <- c("\\usage{",
~ unlist(lapply(promptList, "[[", "usage")),
~ "}",
~ paste("%- maybe also 'usage' for other objects",
~ "documented here."))
~ arguments <- unique (unlist (lapply(promptList, "[[", "arg.n")))
~ Rdtxt$arguments <- if(length(arguments))
~ c("\\arguments{",
~ paste0(" \\item{", arguments, "}{",
~ " ~~Describe \\code{", arguments, "} here~~ }"),
~ "}")
~ Rdtxt$details <- c("\\details{",
~ paste(" ~~ If necessary, more details than the",
~ "description above ~~"),
~ "}")
~ Rdtxt$value <- c("\\value{",
~ " ~Describe the values returned",
~ " If it is a LIST, use",
~ " \\item{comp1 }{Description of 'comp1'}",
~ " \\item{comp2 }{Description of 'comp2'}",
~ " ...",
~ "}")
~ Rdtxt$references <- paste("\\references{ ~put references to the",
~ "literature/web site here ~ }")
~ Rdtxt$author <- "\\author{Daniel Saban\\'es Bov\\'e}"
~ Rdtxt$note <- c("\\note{ ~~further notes~~ ",
~ "",
~ paste(" ~Make other sections like Warning with",
~ "\\section{Warning }{....} ~"),
~ "}")
~ Rdtxt$seealso <- paste("\\seealso{ ~~objects to See Also as",
~ "\\code{\\link{help}}, ~~~ }")
~ Rdtxt$examples <- c("\\examples{",
~ "##---- Should be DIRECTLY executable !! ----",
~ "##-- ==> Define data, use random,",
~ "##--\tor do help(data=index) for the
standard data sets.",
~ "",
~ "## The functions are currently defined as",
~ unlist (lapply(promptList, "[[", "x.def")),
~ "}")
~ Rdtxt$keywords <- c(paste("% Add one or more standard keywords,",
~ "see file 'KEYWORDS' in the"),
~ "% R documentation directory.",
~ "\\keyword{ ~kwd1 }",
~ "\\keyword{ ~kwd2 }% __ONLY ONE__ keyword per
line")

~ ## and write text to console
~ if (is.na(filename))
~ return(Rdtxt)

~ ## or file
~ if(file.exists(filename) && !overwrite)
~ warning(filename, " already exists. Choose overwrite = TRUE to
force.")
~ else {
~ cat(unlist(Rdtxt), file = filename, sep = "\n")
~ message(gettextf("Created file named '%s'.", filename), "\n",
~ gettext("Edit the file and move it to the appropriate
directory."),
~ domain = NA)
~ }

~ ## and return the file name
~ invisible(filename)

}

## helper function for one name only
.promptFunction <- function(name, ...)
{
~ ## utility functions
~ paste0 <- function(...) paste(..., sep = "")
~ is.missing.arg <- function(arg)
~ typeof(arg) == "symbol" && deparse(arg) == ""

~ ## get object by name
~ x <- get(name, envir = parent.frame())

~ ## set up return list
~ ret <- list()

~ ## extract arguments
~ n <- length(argls <- formals(x))
~ if (n > 0) {
~ arg.names <- arg.n <- names(argls)
~ arg.n[arg.n == "..."] <- "\\dots"
~ }
~ Call <- paste0(name, "(")
~ for (i in seq_len(n)) {
~ Call <- paste0(Call, arg.names[i], if (!is.missing.arg(argls[[i]]))
~ paste0(" = ", paste(deparse(argls[[i]],
width.cutoff = 500),
~ collapse = "\n")))
~ if (i != n)
~ Call <- paste0(Call, ", ")
~ }

~ ## and definition of the function
~ x.def <- attr(x, "source")
~ if (is.null(x.def))
~ x.def <- deparse(x)
~ if (any(br <- substr(x.def, 1, 1) == "}"))
~ x.def[br] <- paste(" ", x.def[br])
~ x.def <- gsub("%", "\\\\%", x.def)
~ x.def <- c(paste("##", name), x.def)

~ ## fill return list
~ ret$usage <- paste0(Call, ")")
~ ret$x.def <- x.def
~ ret$arg.n <- if(n > 0) arg.n

~ ## return the list
~ return(ret)

}

## test this
test <- function(x){
~ x + 5

}
b <- function(y)
~ test(y)

y <- function(a, b, c){
~ print("hello")

}

promptFunctions(test, b, names = "y", rdname = "testbandy") -----BEGIN PGP SIGNATURE-----
Version: GnuPG v2.0.4-svn0 (GNU/Linux)
Comment: Using GnuPG with SUSE - http://enigmail.mozdev.org

iD8DBQFIAh46zHZ0x5+gF9kRCnaOAJ9MQGHjosFEFshWYxAbfQ0E7fOsGQCfX2gp F0pJGX4/mai08ghJwj6yY18=
=7r90
-----END PGP SIGNATURE-----



R-devel_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel Received on Mon 14 Apr 2008 - 07:26:11 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Tue 15 Apr 2008 - 04:31:09 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-devel. Please read the posting guide before posting to the list.

list of date sections of archive