[Rd] promptFunctions() to handle multiple names
John Chambers
jmc at r-project.org
Mon Apr 14 20:14:35 CEST 2008
Daniel,
Check out the promptAll() function in the SoDA package on CRAN.
(Because it was written as an example for my new book, it's not the
fanciest imaginable, but seems to work OK.)
John
Daniel Sabanés Bové wrote:
> -----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
>
>
More information about the R-devel
mailing list