Hi Michael,
I must admit to reading this quickly, so I may have missed the point.
match.arg() takes character arguments. I think that you should be able to
use identical() to test whether the argument given is det or tr, as in
> d <- det
> identical(d, det)
[1] TRUE
> tr <- function(x) sum(diag(x))
> identical(d, tr)
If you really want to supply a list of functions as the default, then you
could do something like
f <- function(FUN = c(det, tr)){
FUN <- if (missing(FUN)) FUN[[1]]
else{
if (!any(sapply(c(det, tr), identical, FUN)))
stop("FUN must be det or tr")
FUN
}
FUN
}
I hope this helps,
John
> -----Original Message-----
> From: r-help-boun...@r-project.org [mailto:r-help-bounces@r-
> project.org] On Behalf Of Michael Friendly
> Sent: January-31-12 10:26 AM
> To: R-help
> Subject: [R] Using match.arg() with list of functions?
>
> I have a function of two arguments, (m, n) that returns a list with
> the same structure as the function makefoo below.
> When m=1, it returns a list of vectors, each of length n.
> When m>1, it returns a list of square matrices, each of size m x m.
>
> makefoo <- function(m, n) {
> if (m==1) {
> A <- sample(1:100, n)
> B <- sample(1:100, n)
> C <- sample(1:100, n)
> }
> else {
> A <- B <- C <- list(rep(0, n))
> for (i in seq(n)) {
> A[[i]] <- matrix(sample(1:100, m^2), m, m)
> B[[i]] <- matrix(sample(1:100, m^2), m, m)
> C[[i]] <- matrix(sample(1:100, m^2), m, m)
> }
> }
> result <- list(m=m, A=A, B=B, C=C)
> class(result) <- "foo"
> result
> }
>
> I'd like to define an as.data.frame function for class "foo" object
> that applies either det() or tr() to the matrices in the case m>1.
> The function below works, but I'd rather define the argument FUN as
> c(det, tr) and use something like match.arg(FUN) to determine which
> was supplied. Is there some easy way to do this?
>
> # matrix trace
> tr <- function(M) sum(diag(M))
>
> # why can't I use FUN=c(det, tr) & match.arg(FUN) below?
> as.data.frame.foo <- function(x, FUN=det) {
> m <- x$m
> if(m==1) df <- with(x, data.frame(A, B, C))
> else {
> # FUN <- match.arg(FUN)
> A <- unlist(lapply(x$A, FUN))
> B <- unlist(lapply(x$B, FUN))
> C <- unlist(lapply(x$C, FUN))
> df <- data.frame(A, B, C)
> colnames(df) <- paste(deparse(substitute(FUN)), c("A", "B",
> "C"), sep="")
> }
> df
> }
>
> ### Test cases ####
>
> > foo1 <- makefoo(1, 4)
> > as.data.frame(foo1)
> A B C
> 1 38 86 49
> 2 67 65 2
> 3 41 46 82
> 4 59 8 78
> >
>
> > foo2 <- makefoo(2, 4)
> > as.data.frame(foo2)
> detA detB detC
> 1 -342 -5076 -2621
> 2 -4712 1568 -1724
> 3 -4491 -1892 -2768
> 4 2990 -5448 2974
> > as.data.frame(foo2, FUN=tr)
> trA trB trC
> 1 118 65 80
> 2 62 85 99
> 3 108 86 98
> 4 110 23 129
> >
>
>
>
>
> --
> Michael Friendly Email: friendly AT yorku DOT ca
> Professor, Psychology Dept.
> York University Voice: 416 736-5115 x66249 Fax: 416 736-5814
> 4700 Keele Street Web: http://www.datavis.ca
> Toronto, ONT M3J 1P3 CANADA
>
> ______________________________________________
> R-help@r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-
> guide.html
> and provide commented, minimal, self-contained, reproducible code.
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
