¿Hay alguna forma de usar tryCatch (o similar) en R como un bucle, o de manipular expr en el argumento de advertencia?

Nov 27 2020

Tengo un modelo de regresión ( lmo glmo lmer...) y hago fitmodel <- lm(inputs)donde inputslos cambios dentro de un bucle (la fórmula y los datos). Entonces, si la función del modelo no produce ninguna advertencia, quiero mantenerme fitmodel, pero si me sale una advertencia, quiero que updateel modelo y no se imprima la advertencia , entonces lo hago fitmodel <- lm(inputs)adentro tryCatch. Entonces, si produce una advertencia, adentro warning = function(w){f(fitmodel)}, f(fitmodel)sería algo como

fitmodel <- update(fitmodel, something suitable to do on the model)

De hecho, esta asignación estaría dentro de una if-elseestructura de tal manera que dependiendo del aviso if(w$message satisfies something)adaptaría el suitable to do on the modelinterior update.

El problema es que consigo Error in ... object 'fitmodel' not found. Si lo uso withCallingHandlerscon invokeRestarts, simplemente termina el cálculo del modelo con la advertencia sin updateél. Si vuelvo a agregar fitmodel <- lm(inputs)adentro something suitable to do on the model, se imprime la advertencia; ahora creo que podría intentarlo suppresswarnings(fitmodel <- lm(inputs)), pero aún así creo que no es una solución elegante, ya que tengo que sumar 2 veces la línea fitmodel <- lm(inputs), haciendo 2 veces todo el cálculo (por dentro expry por dentro warning).

Resumiendo, lo que me gustaría pero falla es:

tryCatch(expr = {fitmodel <- lm(inputs)},
         warning = function(w) {if (w$message satisfies something) {
                                    fitmodel <- update(fitmodel, something suitable to do on the model)
                                } else if (w$message satisfies something2){
                                    fitmodel <- update(fitmodel, something2 suitable to do on the model)

                                }
         }
)

¿Que puedo hacer?

La parte del bucle de la pregunta es porque pensé que era la siguiente (tal vez sea otra pregunta, pero por el momento la dejo aquí): puede suceder que después del updaterecibo otra advertencia, entonces haría algo como while(get a warning on update){update}; de alguna manera, este updateinterior warningdebe entenderse también como expr. ¿Es posible algo como esto?

¡Muchas gracias!


Versión genérica de la pregunta con ejemplo mínimo:

Digamos que tengo un tryCatch(expr = {result <- operations}, warning = function(w){f(...)}y si recibo una advertencia en expr(producido de hecho en operations) Quiero hacer algo con result, entonces lo haría warning = function(w){f(result)}, pero luego obtengo Error in ... object 'result' not found.

Un ejemplo mínimo:

y <- "a"
tryCatch(expr = {x <- as.numeric(y)},
    warning = function(w) {print(x)})
Error in ... object 'x' not found

Intenté usar en withCallingHandlerslugar de tryCatchsin éxito, y también usar, invokeRestartpero hace la parte de expresión, no lo que quiero hacer cuando recibo una advertencia.

¿Usted me podría ayudar?

¡Gracias!

Respuestas

2 KonradRudolph Nov 28 2020 at 14:24

El problema, fundamentalmente, es que se llama al controlador antes de que ocurra la asignación. E incluso si ese no fuera el caso, el controlador se ejecuta en un ámbito diferente al de la tryCatchexpresión, por lo que el controlador no puede acceder a los nombres en el otro ámbito.

Necesitamos separar el manejo de la transformación de valor.

Para errores (pero no advertencias), la base R proporciona la función try, que se envuelve tryCatchpara lograr este efecto. Sin embargo, tryse desaconseja su uso, porque su tipo de retorno no es correcto . 1 Como se menciona en la respuesta de ekoam , 'purrr' proporciona envoltorios funcionales bien tipificados (por ejemplo safely) para lograr un efecto similar.

Sin embargo, también podemos construir el nuestro, que podría encajar mejor en esta situación:

with_warning = function (expr) {
    self = environment()
    warning = NULL

    result = withCallingHandlers(expr, warning = function (w) {
        self$warning = w
        tryInvokeRestart('muffleWarning')
    })
    list(result = result, warning = warning)
}

Esto nos da una envoltura que distingue entre el valor del resultado y una advertencia. Ahora podemos usarlo para implementar su requisito:

fitmodel = with(with_warning(lm(inputs)), {
    if (! is.null(warning)) {
        if (conditionMessage(warning) satisfies something) {
            update(result, something suitable to do on the model)
        } else {
            update(result, something2 suitable to do on the model)
        }
    } else {
        result
    }
})

1 Lo que esto significa es que tryel tipo de retorno de 'no distingue entre un error y un valor de tipo sin error try-error. Esta es una situación real que puede ocurrir, por ejemplo, al anidar varias tryllamadas.

2 ekoam Nov 27 2020 at 11:37

Parece que está buscando un contenedor funcional que capture tanto el valor devuelto como los efectos secundarios de una llamada de función. Creo que purrr::quietlyes un candidato perfecto para este tipo de tareas. Considere algo como esto

quietly <- purrr::quietly

foo <- function(x) {
  if (x < 3)
    warning(x, " is less than 3")
  if (x < 4)
    warning(x, " is less than 4")
  x
}

update_foo <- function(x, y) {
  x <- x + y
  foo(x)
}

keep_doing <- function(inputs) {
  out <- quietly(foo)(inputs)
  repeat {
    if (length(out$warnings) < 1L) return(out$result)
    
    cat(paste0(out$warnings, collapse = ", "), "\n") # This is for you to see the process. You can delete this line. if (grepl("less than 3", out$warnings[[1L]])) {
      out <- quietly(update_foo)(out$result, 1.5) } else if (grepl("less than 4", out$warnings[[1L]])) {
      out <- quietly(update_foo)(out$result, 1)
    }
  }
}

Salida

> keep_doing(1)
1 is less than 3, 1 is less than 4 
2.5 is less than 3, 2.5 is less than 4 
[1] 4

> keep_doing(3)
3 is less than 4 
[1] 4
1 RuiBarradas Nov 27 2020 at 10:38

¿Está buscando algo como lo siguiente? Si se ejecuta con y <- "123", "OK"se imprimirá el mensaje.

y <- "a"
#y <- "123"
x <- tryCatch(as.numeric(y),
              warning = function(w) w
)
if(inherits(x, "warning")){
  message(x$message)
} else{
  message(paste("OK:", x))
}

Es más fácil probar varios valores de argumentos con el código anterior reescrito como una función.

testWarning <- function(x){
  out <- tryCatch(as.numeric(x),
                  warning = function(w) w
  )
  if(inherits(out, "warning")){
    message(out$message)
  } else{
    message(paste("OK:", out))
  }
  invisible(out)
}

testWarning("a")
#NAs introduced by coercion
testWarning("123")
#OK: 123
JoaoPedroMacalos Nov 27 2020 at 10:04

¿Quizás podría asignar xnuevamente en la condición de manejo?

tryCatch(
  warning = function(cnd) {
    x <- suppressWarnings(as.numeric(y))
    print(x)},
  expr = {x <- as.numeric(y)}
)
#> [1] NA

Quizás no sea la respuesta más elegante, pero resuelve tu ejemplo de juguete.

user2554330 Nov 27 2020 at 10:05

No ponga la tarea en la tryCatchllamada, déjela afuera. Por ejemplo,

y <- "a"
x <- tryCatch(expr = {as.numeric(y)},
    warning = function(w) {y})

Esto se asigna ya x, pero puede poner cualquier cosa en el cuerpo de advertencia y el resultado se asignará a x.

Su ejemplo de "lo que me gustaría" es más complicado, porque desea acceder al exprvalor, pero no se ha asignado en ningún lugar en el momento en que se genera la advertencia. Creo que tendrás que volver a calcularlo:

fitmodel <- tryCatch(expr = {lm(inputs)},
         warning = function(w) {if (w$message satisfies something) { update(lm(inputs), something suitable to do on the model) } else if (w$message satisfies something2){
                                    update(lm(inputs), something2 suitable to do on the model)

                                }
         }
)

Editado para agregar:

Para permitir que la evaluación continúe hasta su finalización antes de procesar la advertencia, no puede usar tryCatch. El evaluatepaquete tiene una función (también llamada evaluate) que puede hacer esto. Por ejemplo,

y <- "a"
res <- evaluate::evaluate(quote(x <- as.numeric(y)))
for (i in seq_along(res)) {
    if (inherits(res[[i]], "warning") && 
        conditionMessage(res[[i]]) == gettext("NAs introduced by coercion",
                                              domain = "R"))
        x <- y
}

Algunas notas: la reslista contendrá muchas cosas diferentes, incluidos mensajes, advertencias, errores, etc. Mi código solo mira las advertencias. Solía conditionMessageextraer el mensaje de advertencia, pero se traducirá al idioma local, por lo que debe usar gettextpara traducir la versión en inglés del mensaje para comparar.