Как вернуть объекты, созданные в функции, и игнорировать объекты с ошибкой / NA?

#r #fitdistrplus

#r #fitdistrplus

Вопрос:

Я отредактировал свой вопрос

Цель

Я хочу сохранить только те объекты, которые были успешно созданы, и игнорировать те, которые вызвали ошибки.

Пример

Пожалуйста, обратите внимание, что это всего лишь воспроизводимый пример. Мой исходный набор данных отличается.

Следующая функция принимает любую переменную mtcars dataset, соответствует трем теоретическим распределениям, а затем возвращает статистику соответствия:

 library(fitdistrplus)

fit_distt <- function(var) {
  
v <- mtcars[, var]
  
f1 <- fitdist(data = v, distr = "norm")

f2 <- fitdist(data = v, distr = "nbinom")

f3 <- fitdist(data = v, distr = "gamma")

gofstat(f = list(f1, f2, f3), 
        chisqbreaks = c(0, 3, 3.5, 4, 4.5, 
                        5, 10, 20, 30, 40),
        fitnames = c("normal", "nbinom", "gamma"))

}
  

Например:

 > fit_distt("gear")
Goodness-of-fit statistics
                                normal    nbinom     gamma
Kolmogorov-Smirnov statistic 0.2968616 0.4967268 0.3030232
Cramer-von Mises statistic   0.4944390 1.5117544 0.5153004
Anderson-Darling statistic   3.1060083 7.2858460 3.1742713

Goodness-of-fit criteria
                                 normal   nbinom    gamma
Akaike's Information Criterion 74.33518 109.9331 72.07507
Bayesian Information Criterion 77.26665 112.8646 75.00655
  

Проблема

Некоторые теоретические распределения не соответствуют переменной и fitdist выдают ошибку:

 > fit_distt("mpg")
<simpleError in optim(par = vstart, fn = fnobj, fix.arg = fix.arg, obs = data,     gr = gradient, ddistnam = ddistname, hessian = TRUE, method = meth,     lower = lower, upper = upper, ...): function cannot be evaluated at initial parameters>
 Error in fitdist(data = v, distr = "nbinom") : 
  the function mle failed to estimate the parameters, 
                with the error code 100 
  

Эта ошибка произошла при f2 попытке поместить объект nbinom в непрерывную переменную mpg . Но norm и gamma успешно подходят.

Я хочу вернуть gofstat для успешно подобранных дистрибутивов и игнорировать те, которые выдали ошибку.

Ожидаемый результат

Несмотря f2 на то, что в функции указано значение is, если оно выдает ошибку, мне все равно нужен следующий вывод:

 > fit_distt("mpg")
Goodness-of-fit statistics
                                 normal      gamma
Kolmogorov-Smirnov statistic 0.12485059 0.08841088
Cramer-von Mises statistic   0.08800019 0.03793323
Anderson-Darling statistic   0.58886727 0.28886166

Goodness-of-fit criteria
                                 normal    gamma
Akaike's Information Criterion 208.7555 205.8416
Bayesian Information Criterion 211.6870 208.7731
  

Что я пробовал

Очевидно, я могу просто удалить f2 из функции. Но это означает повторение всего кода для каждой переменной. Это много кода! Итак, я все еще хочу использовать функцию.

И я хочу иметь возможность использовать функцию для любой переменной. С mtcars$mpg , функция завершается с ошибкой для nbinom , но с mtcars$vs , функция завершается с ошибкой для gamma . В любом случае я хочу пропустить совпадения, которые вызвали ошибку, и сообщить gofstat о совпадениях, которые сработали.

Я могу использовать purrr::possibly , чтобы незаметно возвращать подходящий результат или выдавать ошибку, не останавливаясь на ошибке. Но я не знаю, как вернуть успешно подходящие значения только в gofstat .

Комментарии:

1. Вы можете вернуть my_vector[!is.na(my_vector)] в функцию или обернуть текущую функцию в na.omit

2. Да, но это не мой вопрос. Я хочу вернуть только те средние значения, которые были вычислены. Когда среднее значение не вычисляется, я хочу его исключить. NA есть одна возможность, но что, если f11 она даже не создана?

3. Вы должны привести пример того, что вы подразумеваете под этим, и пояснить свой пост. В вашем большом разделе «Вопрос» и в вашем примере кода упоминаются только NA значения. Кроме того, я бы настоятельно рекомендовал изучить семейство apply функций or map , что-то вроде: lapply(my_list_1, mean)

4. @astrofunkswag, уточнил и добавил соответствующий пример.

Ответ №1:

Вы могли бы попробовать try . Попробуйте подогнать дистрибутив и добавляйте его в список, который вы передаете, только gofstat если он работает:

 library(fitdistrplus)
#> Loading required package: MASS
#> Loading required package: survival


fit_distt <- function(var) {
  
  v <- mtcars[, var]
  
  distributions <- c("norm", "nbinom", "gamma")
  
  fs <- list()
  fitted_distributions <- vector(mode = "character")
  for (i in seq_along(distributions)) {
    # try to fit the model
    fit <- try(fitdist(data = v, distr = distributions[i]), silent = TRUE)    
    
    # if it works, add it to fs. If not, ¯_(ツ)_/¯
    if (!inherits(fit, "try-error")) {
      fs[[length(fs) 1]] <- fit
      fitted_distributions[length(fitted_distributions) 1] <-  distributions[i]
    }
  }
  
  gofstat(f = fs,
          chisqbreaks = c(0, 3, 3.5, 4, 4.5, 
                          5, 10, 20, 30, 40),
          fitnames = fitted_distributions)
  
}

fit_distt("mpg")
#> <simpleError in optim(par = vstart, fn = fnobj, fix.arg = fix.arg, obs = data,     gr = gradient, ddistnam = ddistname, hessian = TRUE, method = meth,     lower = lower, upper = upper, ...): function cannot be evaluated at initial parameters>
#> Goodness-of-fit statistics
#>                                    norm      gamma
#> Kolmogorov-Smirnov statistic 0.12485059 0.08841088
#> Cramer-von Mises statistic   0.08800019 0.03793323
#> Anderson-Darling statistic   0.58886727 0.28886166
#> 
#> Goodness-of-fit criteria
#>                                    norm    gamma
#> Akaike's Information Criterion 208.7555 205.8416
#> Bayesian Information Criterion 211.6870 208.7731
  

Создано 2020-10-07 пакетом reprex (версия 0.3.0)

Ответ №2:

Вы можете заменить отдельные подмножества списка одним lapply . Если вы получите это, чтобы вернуть a NULL , а не an NA , запись исчезнет после того, как ее не будет в списке. Поэтому следующая функция будет делать то, что вы хотите, как показано в этом представлении:

 find_mean_of_each_vector_in_a_list <- function(my_list) {
 suppressWarnings(
   as.numeric(
     unlist(
       sapply(my_list,  function(x) if(is.na(mean(x))) NULL else mean(x))
       )))
}

my_list_1 <- list(a = 1:3, b = 5:6, c = 7:10)
my_list_2 <- list(a = 1:3, b = c("a", "b"), c = 7:10)

find_mean_of_each_vector_in_a_list(my_list_1)
#> [1] 2.0 5.5 8.5
find_mean_of_each_vector_in_a_list(my_list_2)
#> [1] 2.0 8.5
  

Создано 2020-10-07 пакетом reprex (версия 0.3.0)