# Re: [Rd] Vectorized switch

From: William Dunlap <wdunlap_at_tibco.com>
Date: Fri, 18 Dec 2009 11:39:41 -0800

> -----Original Message-----
> From: r-devel-bounces_at_r-project.org
> [mailto:r-devel-bounces_at_r-project.org] On Behalf Of Stavros Macrakis
> Sent: Friday, December 18, 2009 11:07 AM
> To: r-devel_at_r-project.org
> Subject: [Rd] Vectorized switch
>
> What is the 'idiomatic' way of writing a vectorized switch statement?
>
> That is, I would like to write, e.g.,
>
> vswitch( c('a','x','b','a'),
> a= 1:4,
> b=11:14,
> 100 )
> => c(1, 100, 13, 4 )
>
> equivalent to
>
> ifelse( c('a','x','b','a') == 'a', 1:4,
> ifelse( c('a','x','b','a') == 'b', 11:14,
> 100 ) )
>
> A simple way of doing this is (leaving aside the default case):
>
> colchoose <- function(frame,selector)
>
> mapply(function(a,b)frame[a,b],seq_along(frame),selector))
>
> colchoose( data.frame(a=1:4,b=11:14), c('a','b','b','a'))
> => c(1,11,11,1)

I thought you would want c(1,12,13,4), not c(1,11,11,1), out of this call. Perhaps I misunderstand your requirements.

> f1<-function(frame, selector) {

```        selector <- match(selector, colnames(frame))
frame[cbind(seq_along(selector), selector)]
```
}
> f1(data.frame(a=1:4,b=11:14), c('a','b','b','a'))    1 12 13 4
> f1(cbind(a=1:4,b=11:14), c('a','b','b','a'))    1 12 13 4

A looping approach that did not use repeated calls to [.data.frame should also be pretty quick. E.g.,

f2 <- function (namedList, selector) {

```      result <- namedList[] # just to get class and length right
for (n in unique(selector)) {
i <- n == selector
result[i] <- namedList[[n]][i]
}
result
```

}
> f2(list(a=1:4,b=11:14), c('a','b','b','a'))    1 12 13 4

Bill Dunlap
Spotfire, TIBCO Software
wdunlap tibco.com

>
> But of course this is not very efficient compared to the way
> ifelse works.
>
> Is there a standard function or idiom for this (am I missing something
> obvious?), or should I write my own?
>
> -s
>
> [[alternative HTML version deleted]]
>
> ______________________________________________
> R-devel_at_r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>

R-devel_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel Received on Fri 18 Dec 2009 - 19:46:01 GMT

This archive was generated by hypermail 2.2.0 : Fri 18 Dec 2009 - 20:01:10 GMT