R modismo para switch/case

Question

Tengo algo de código R que se ve básicamente como esto:

compute.quantiles <- function(mu, type) { 

    ## 'mu' and 'type' are vectors of the same length 

    var <- ifelse(type=='a', 6.3523 * mu^2, 
     ifelse(type=='b', 234.23 * mu, 
     ifelse(type=='c', {s <- 9.8 * ((mu-0.3)/3)^(6/7)+0.19; mu + mu^2/s}, 
     ifelse(type=='d', 56.345 * mu^1.5, 
     ifelse(type=='e', 0.238986 * mu^2, 
     ifelse(type=='f', mu + 1.1868823 * mu^2, 
     NA)))))) 

    # ...then do something with var... 
} 

Parte de la muestra de entrada & de salida:

print(compute.quantiles(2:4, c('c','d','e'))) 
[1] 2.643840 292.777208 3.823776 

que funciona correctamente, pero es una especie de feo con la anidación profunda, así que me pregunto si hay un idioma diferente que funciona mejor. Alguien tiene una sugerencia? Si switch() aceptara un vector como primer argumento, eso funcionaría muy bien, pero solo toma un escalar.

Answer 1

creo que se me ocurrió algo que me gusta mejor:

## Vector-switch 
vswitch <- function(EXPR, ...) { 
    vars <- cbind(...) 
    vars[cbind(seq_along(EXPR), match(EXPR, names(list(...))))] 
} 

compute.quantiles <- function(mu, type) { 
    stopifnot(length(mu) == length(type)) 

    vswitch(type, 
    a = 6.3523 * mu^2, 
    b = 234.23 * mu, 
    c = mu + mu^2/(9.8 * ((mu-0.3)/3)^(6/7)+0.19), 
    d = 56.345 * mu^1.5, 
    e = 0.238986 * mu^2, 
    f = mu + 1.1868823 * mu^2) 
} 

Con el código de matriz de indexación en sólo 2 líneas, creo que está bien para mi umbral de código demasiado inteligente. =)

Answer 2

Tal vez algo como esto es viable:

compute.quantiles <- function(mu, type) { 
    stopifnot(length(mu) == length(type)) 

    vars <- cbind(
    a = 6.3523 * mu^2, 
    b = 234.23 * mu, 
    c = mu + mu^2/(9.8 * ((mu-0.3)/3)^(6/7)+0.19), 
    d = 56.345 * mu^1.5, 
    e = 0.238986 * mu^2, 
    f = mu + 1.1868823 * mu^2) 

    vars[cbind(seq_along(mu), match(type, colnames(vars)))] 
} 

No estoy seguro si eso va a parecer demasiado "avanzada" para el futuro lector (incluido yo mismo) sin embargo.

Answer 3

No pude evitar agregar otra respuesta con un enfoque completamente diferente. Aquí está.

## Sort of a cross between tapply() and ave() 
tswitch <- function(x, INDEX, ...) { 
    l <- substitute(list(...)) 
    s <- split(x, INDEX) 
    pf <- parent.frame() 
    split(x, INDEX) <- lapply(names(s), function(n) 
    eval(l[[n]], list(x=s[[n]]), pf) 
) 
    x 
} 

compute.quantiles <- function(mu, type) { 
    stopifnot(length(mu) == length(type)) 

    tswitch(mu, type, 
    a = 6.3523 * x^2, 
    b = 234.23 * x, 
    c = x + x^2/(9.8 * ((x-0.3)/3)^(6/7)+0.19), 
    d = 56.345 * x^1.5, 
    e = 0.238986 * x^2, 
    f = x + 1.1868823 * x^2) 
} 

Y la salida de entrada de ejemplo &:

> compute.quantiles(2:4, c('c','d','e')) 
[1] 2.643840 292.777208 3.823776 

La ventaja de esta aplicación es que sólo computa las length(mu) valores específicos que necesitan ser computada. Por el contrario, el método vswitch anterior calcula length(mu) * M valores, donde M es el número de "casos" en el conmutador. Entonces, si los cálculos son costosos o si los datos son grandes, esta versión podría ser una ganancia.

Answer 4

Aquí es un enfoque alternativo:

library(data.table) 
# Case selection table: 
dtswitch <- data.table(type=letters[1:6], 
         result=c("6.3523 * mu^2", 
           "234.23 * mu", 
           "{s <- 9.8 * ((mu-0.3)/3)^(6/7)+0.19; mu + mu^2/s}", 
           "56.345 * mu^1.5", 
           "0.238986 * mu^2", 
           "mu + 1.1868823 * mu^2"), 
         key="type") 

# Data to which you want the cases applied: 
compute <- data.table(type=letters[3:5],mu=2:4,key="type") 

# Join the data table with the case selection table, and evaluate the results: 
dtswitch[compute,list(mu,result=eval(parse(text=result)))] 
#> type mu  result 
#>1: c 2 2.643840 
#>2: d 3 292.777208 
#>3: e 4 3.823776 

En lugar de crear la tabla dtswitch en código R, se puede almacenar en una hoja de cálculo o base de datos externa y luego cargarlo en R. Podría ser útil si usted tiene muchos casos diferentes o cambian con frecuencia y desea controlarlos desde una ubicación central.

Answer 5

La implementación de Ken Williams de vswitch no funciona bien para algunos tipos de entradas. Creo que éste es más flexible:

vswitch <- function(expr, ...) { 
    lookup <- list(...) 
    vec <- as.character(expr) 
    vec[is.na(vec)] <- "NA" 
    unname(do.call(c, lookup[vec])) 
} 

usarlo con valores de búsqueda numéricos, es necesario citar o backquote ellos:

num_vec <- c(1, 3, 2, 2, 1) 
vswitch(num_vec, `1` = 10, `2` = 25, `3` = 50) 
## [1] 10 50 25 25 10 

Con las búsquedas de caracteres:

char_vec <- letters[num_vec] 
vswitch(char_vec, a = "Albert", b = "Bertrand", c = "Charles") 
## [1] "Albert" "Charles" "Bertrand" "Bertrand" "Albert"