R devel - Apr 2008 - promptFunctions() to handle multiple names

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

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