Проблема в том, что EQ_A0
не является векторизованной функцией для параметров S_a
и cc
. Предупреждение (не ошибка)
Warning message:
In dgamma(tau, shape = S_a, scale = lambda_a * c, log = TRUE) - :
longer object length is not a multiple of shorter object length
возникает внутри h_A0
и связано с тем, что S_a
и cc
являются 2-векторами длины вместо скаляров (Вы можете проверить это, добавив оператор browser()
).
Как я уже упоминал в своем комментарии, результат dgamma(tau, shape=S_a, scale = lambda_a*c, log = TRUE)
- это вектор длины 21
, а результат pgamma(30, shape=S_a, scale = lambda_a*c, lower.tail = TRUE, log.p=TRUE)
- это вектор длины 2
, Следовательно, при вычитании последнего из первого R
возникает предупреждение, поскольку 21
(длина более длинного объекта) не кратно 2
(длина более короткого объекта). R
все еще выполняет вычисления, но выдает ложный результат.
Кроме того, это не относится к mutate
, который можно проверить с помощью EQ_A0(df$Sa, 350, df$cc)
(это то, что вы пытаетесь сделать с mutate
).
Для решения этой проблемы у вас есть l oop над строками параметров в вашем фрейме данных с map2_dbl
(эквивалент mapply(EQ_A0, df$Sa, lambda_a, df$cc)
) или с использованием rowwise
:
library(dplyr)
library(purrr)
EQ_A0 <- function(S_a, lambda_a, c){
integrate(integrand2, 0, 30, S_a, lambda_a, c, subdivisions=2000, rel.tol=.Machine$double.eps^.05)$value
}
integrand2 <- function(tau, S_a, lambda_a, c){
exp(log(tau)+h_A0(tau, S_a, lambda_a, c))
}
h_A0 <- function(tau, S_a, lambda_a, c){
#browser()
dgamma(tau, shape=S_a, scale = lambda_a*c, log = TRUE) - pgamma(30, shape=S_a, scale = lambda_a*c, lower.tail = TRUE, log.p=TRUE)
}
df <- data.frame(cc=c(0.06329820, 0.05141647), ya=c(31, 256), Sa=c(31,256), yb=c(2865, 742), Sb=c(2993, 1348))
# Solution 1: use map2_dbl to loop over parameters
df %>%
mutate(asd = map2_dbl(Sa, cc, ~ EQ_A0(.x, 350, .y)))
#> cc ya Sa yb Sb asd
#> 1 0.06329820 31 31 2865 2993 29.02379
#> 2 0.05141647 256 256 742 1348 29.88251
# Solution 1: use rowwise to loop over parameters
df %>%
rowwise() %>%
mutate(asd=EQ_A0(Sa, 350, cc)) %>%
ungroup()
#> # A tibble: 2 x 6
#> cc ya Sa yb Sb asd
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 0.0633 31 31 2865 2993 29.0
#> 2 0.0514 256 256 742 1348 29.9
Создано в 2020-04-04 пакетом представ (v0.3.0)