r - htmloutput - tags$img shiny

R idioma para el interruptor/caja

Question

Tengo un código R que se parece básicamente a 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...
}

Algunos ejemplos de entrada y salida:

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

Eso funciona correctamente, pero es un poco feo con la anidación profunda, así que me pregunto si hay un idioma diferente que funcione mejor. ¿Alguien tiene alguna sugerencia? Si switch() aceptara un vector como su primer argumento, funcionaría bien, pero solo toma un escalar.

Answer 1

Aquí hay 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, puede almacenarla en una hoja de cálculo externa o en una base de datos y luego cargarla en R. Podría ser útil si tiene muchos casos diferentes o si cambian a menudo y desea controlarlos. Una ubicación central.

Answer 2

Creo que se me ocurrió algo que me gusta más:

## 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 indexación de matriz en solo 2 líneas, creo que está bien para mi umbral de código demasiado inteligente. =)

Answer 3

La implementación de Ken Williams de vswitch no funciona bien para algún tipo de entradas. Creo que este es más flexible:

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

Para usarlo con valores de búsqueda numéricos, debe citarlos o escribirlos de nuevo:

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

Con búsquedas de personajes:

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

Answer 4

No pude resistir 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 muestra de entrada y salida:

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

La ventaja de esta implementación es que solo calcula los valores específicos de length(mu) que deben calcularse. Por el contrario, el método anterior del vswitch calcula la length(mu) * M valores, donde M es el número de "casos" en el interruptor. Entonces, si los cálculos son costosos, o si los datos son grandes, esta versión podría ser una victoria.

Answer 5

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

Sin embargo, no estoy seguro de si eso va a parecer demasiado "avanzado" para el futuro lector (incluido yo mismo).