From jmc at r-project.org  Mon Apr 14 20:14:35 2008
From: jmc at r-project.org (John Chambers)
Date: Mon, 14 Apr 2008 11:14:35 -0700
Subject: [Rd] promptFunctions() to handle multiple names
In-Reply-To: <48021E3B.1080000@campus.lmu.de>
References: <48021E3B.1080000@campus.lmu.de>
Message-ID: <48039F0B.2030808@r-project.org>

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
>
>



[Rd] promptFunctions() to handle multiple names
John Chambers