R idiom dla przełącznika/przypadek

Question

Mam trochę kodu R, który wygląda w zasadzie tak:

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

Niektóre próbki wejściowe & wyjściowa:

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

Że działa prawidłowo, ale jest to rodzaj brzydki z głębokim gniazdowaniem, więc zastanawiam się, czy istnieje inny idiom, który działa lepiej. Ktoś ma sugestię? Jeśli switch() zaakceptował wektor jako pierwszy argument, to działałoby ładnie, ale wymaga skalaru.

Answer 1

myślę, że wymyślił coś lubię lepiej:

## 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) 
} 

Z kodu matrycowego indeksowania w zaledwie 2 linie, myślę, że to jest ok na moim progu zbyt mądry kodu. =)

Answer 2

Może coś w tym jest wykonalne:

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)))] 
} 

Nie jestem pewien, czy to będzie wyglądać zbyt „zaawansowane” dla przyszłego czytelnika (w tym ja), choć.

Answer 3

Nie mogłem oprzeć się dodaniu innej odpowiedzi z zupełnie innym podejściem. Oto jest.

## 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) 
} 

A wyjście wejście próbka &:

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

Zaletą tej realizacji jest to, że tylko wylicza konkretne wartości length(mu), które muszą być obliczone. W przeciwieństwie do powyższego, metoda vswitch oblicza wartości length(mu) * M, gdzie M jest liczbą "przypadków" w przełączniku. Więc jeśli obliczenia są kosztowne lub jeśli dane są duże, ta wersja może być wygrana.

Answer 4

Oto alternatywne podejście:

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 

Zamiast tworzenia tabeli dtswitch w kodzie R, można przechowywać go w arkuszu zewnętrznym lub bazy danych, a następnie załadować je do R. Może być przydatny, jeśli masz wiele różnych przypadków lub często się zmieniają i chcesz kontrolować je z centralnej lokalizacji.

Answer 5

Implementacja Ken Williamsa vswitch nie działa dobrze w przypadku niektórych rodzajów danych wejściowych. Myślę, że to jest bardziej elastyczny:

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

go używać z liczbowych wartości odnośników, trzeba zacytować lub backquote je:

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

Z wyszukiwań znakowych:

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