Как я могу улучшить интеграцию и параметризацию свернутых распределений?

Я пытаюсь решить для параметров гамма-распределения, которое свернуто как с нормальным, так и с логнормальным распределением. Я могу экспериментально получить параметры как для нормальной, так и для логнормальной составляющих, поэтому я просто хочу найти параметры гаммы.

Я попытался 3 подхода к этой проблеме:

1) создание свернутых случайных наборов данных (т. е. rnorm()+rlnorm()+rgamma()) и использование регрессии наименьших квадратов на линейных или логарифмических гистограммах данных (не показано, но было очень смещено ГСЧ и вообще не оптимизировалось).

2) численное интегрирование сверточных функций «грубой силой» (пример кода № 1)

3) подходы к численному интегрированию с пакетом distr. (пример кода #2)

У меня был ограниченный успех со всеми тремя подходами. Важно отметить, что эти подходы, по-видимому, хорошо работают для «номинальных» значений гамма-параметров, но все они начинают давать сбои, когда k (форма) низка, а тета (масштаб) высока — именно здесь находятся мои экспериментальные данные. пожалуйста, найдите примеры ниже.

Прямая числовая интеграция

# make the functions
f.N <- function(n) dnorm(n, N[1], N[2])
f.L <- function(l) dlnorm(l, L[1], L[2])
f.G <- function(g) dgamma(g, G[1], scale=G[2])

# make convolved functions
f.Z <- function(z) integrate(function(x,z) f.L(z-x)*f.N(x), -Inf, Inf, z)$value # L+N
f.Z <- Vectorize(f.Z)
f.Z1 <- function(z) integrate(function(x,z) f.G(z-x)*f.Z(x), -Inf, Inf, z)$value # G+(L+N)
f.Z1 <- Vectorize(f.Z1)

# params of Norm, Lnorm, and Gamma
N <- c(0,5)
L <- c(2.5,.5)
G <- c(2,7) # this distribution is the one we ultimately want to solve for.
# G <- c(.5,10) # 0<k<1
# G <- c(.25,5e4) # ballpark params of experimental data 

# generate some data
set.seed(1)
rN <- rnorm(1e4, N[1], N[2])
rL <- rlnorm(1e4, L[1], L[2])
rG <- rgamma(1e4, G[1], scale=G[2])
Z <- rN + rL
Z1 <- rN + rL + rG

# check the fit
hist(Z,freq=F,breaks=100, xlim=c(-10,50), col=rgb(0,0,1,.25))
hist(Z1,freq=F,breaks=100, xlim=c(-10,50), col=rgb(1,0,0,.25), add=T)
z <- seq(-10,50,1)
lines(z,f.Z(z),lty=2,col="blue", lwd=2) # looks great... convolution performs as expected.
lines(z,f.Z1(z),lty=2,col="red", lwd=2) # this works perfectly so long as k(shape)>=1

# I'm guessing the failure to compute when shape 0 < k < 1 is due to 
# numerical integration problems, but I don't know how to fix it.
integrate(dgamma, -Inf, Inf, shape=1, scale=1) # ==1
integrate(dgamma, 0, Inf, shape=1, scale=1) # ==1
integrate(dgamma, -Inf, Inf, shape=.5, scale=1) # !=1
integrate(dgamma, 0, Inf, shape=.5, scale=1) # != 1

# Let's try to estimate gamma anyway, supposing k>=1
optimFUN <- function(par, N, L) {
  print(par)
  -sum(log(f.Z1(Z1[1:4e2])))
}
f.G <- function(g) dgamma(g, par[1], scale=par[2])
fitresult <- optim(c(1.6,5), optimFUN, N=N, L=L)
par <- fitresult$par
lines(z,f.Z1(z),lty=2,col="green3", lwd=2) # not so great... likely better w/ more data, 
# but it is SUPER slow and I observe large step sizes.

Попытка свертки через дистрибутив

# params of Norm, Lnorm, and Gamma
N <- c(0,5)
L <- c(2.5,.5)
G <- c(2,7) # this distribution is the one we ultimately want to solve for.
# G <- c(.5,10) # 0<k<1
# G <- c(.25,5e4) # ballpark params of experimental data 

# make the distributions and "convolvings'
dN <- Norm(N[1], N[2])
dL <- Lnorm(L[1], L[2])
dG <- Gammad(G[1], G[2])
d.NL <- d(convpow(dN+dL,1))
d.NLG <- d(convpow(dN+dL+dG,1)) # for large values of theta, no matter how I change 
# getdistrOption("DefaultNrFFTGridPointsExponent"), grid size is always wrong.

# Generate some data
set.seed(1)
rN <- r(dN)(1e4)
rL <- r(dL)(1e4)
rG <- r(dG)(1e4)
r.NL <- rN + rL
r.NLG <- rN + rL + rG

# check the fit
hist(r.NL, freq=F, breaks=100, xlim=c(-10,50), col=rgb(0,0,1,.25))
hist(r.NLG, freq=F, breaks=100, xlim=c(-10,50), col=rgb(1,0,0,.25), add=T)
z <- seq(-10,50,1)
lines(z,d.NL(z), lty=2, col="blue", lwd=2) # looks great... convolution performs as expected.
lines(z,d.NLG(z), lty=2, col="red", lwd=2) # this appears to work perfectly 
# for most values of K and low values of theta

# this is looking a lot more promising... how about estimating gamma params?
optimFUN <- function(par, dN, dL) {
  tG <- Gammad(par[1],par[2])
  d.NLG <- d(convpow(dN+dL+tG,1))
  p <- d.NLG(r.NLG)
  p[p==0] <- 1e-15 # because sometimes very low probabilities evaluate to 0... 
# ...and logs don't like that.
  -sum(log(p))
}
fitresult <- optim(c(1,1e4), optimFUN, dN=dN, dL=dL)
fdG <- Gammad(fitresult$par[1], fitresult$par[2])
fd.NLG <- d(convpow(dN+dL+fdG,1))
lines(z,fd.NLG(z), lty=2, col="green3", lwd=2) ## this works perfectly when ~k>1 & ~theta<100... but throws
## "Error in validityMethod(object) : shape has to be positive" when k decreases and/or theta increases 
## (boundary subject to RNG).

Можно ли ускорить интеграцию в примере 1? можно ли увеличить размер сетки в примере 2 (пакет дистрибутива)? как я могу решить проблему k‹1? могу ли я изменить масштаб данных таким образом, чтобы облегчить оценку при высоких значениях тета? Есть ли лучший способ все вместе? Помощь!


person PeterFoster    schedule 18.03.2016    source источник
comment
Какое значение вы вкладываете в слово «запутанный»? (В английском языке это слово означает «запутался». Существует математический глагол convolve.) Вы действительно запрашиваете оценку распределения смеси?   -  person IRTFM    schedule 18.03.2016
comment
@42- Чтобы вычислить PDF суммы двух переменных A и B, необходимо вычислить интеграл свертки по линиям PDF(z) = S PDFa(x)*PDFb(z-x) dx, где S — интеграл.   -  person Severin Pappadeux    schedule 18.03.2016
comment
Да, я могу поменять convolute на convolve... Я уверен, вы можете догадаться, что программирование/статистика не является моим основным языком. Как показано в примерах, меня интересует ситуация rnorm(n, mu, sig) + rlnorm(n2, mu2, sig2), а не append(rnorm(n, mu, sig), rlnorm(n2, mu2, sig2)). Я не уверен, что классифицируется как распределение смеси.   -  person PeterFoster    schedule 18.03.2016
comment
Пример кода № 1 имеет именно такую ​​форму (@ Severin P)   -  person PeterFoster    schedule 18.03.2016


Ответы (1)


Что ж, свертка функции с гауссовским ядром требует использования квадратуры Гаусса-Эрмита. В R это реализовано в специальном пакете: https://cran.r-project.org/web/packages/gaussquad/gaussquad.pdf

ОБНОВИТЬ

Для свертки с гамма-распределением этот пакет также может быть полезен с помощью квадратуры Гаусса-Лагерра

ОБНОВЛЕНИЕ II

Вот быстрый код для свертки гауссова с логнормальным, надеюсь, не много ошибок и печатает какой-то разумно выглядящий график

library(gaussquad)

n.quad <- 170 # integration order

# get the particular weights/abscissas as data frame with 2 observables and n.quad observations
rule <- ghermite.h.quadrature.rules(n.quad, mu = 0.0)[[n.quad]]

# test function - integrate 1 over exp(-x^2) from -Inf to Inf
# should get sqrt(pi) as an answer
f <- function(x) {
    1.0
}

q <- ghermite.h.quadrature(f, rule)
print(q - sqrt(pi))

# convolution of lognormal with gaussian
# because of the G-H rules, we have to make our own function
# for simplicity, sigmas are one and mus are zero

sqrt2 <- sqrt(2.0)

c.LG <- function(z) {
   #print(z)

   f.LG <- function(x) {
        t <- (z - x*sqrt2)
        q <- 0.0
        if (t > 0.0) {
            l <- log(t)
            q <- exp( - 0.5*l*l ) / t
        }
        q
   }

   ghermite.h.quadrature(Vectorize(f.LG), rule) / (pi*sqrt2)
}

library(ggplot2)

p <- ggplot(data = data.frame(x = 0), mapping = aes(x = x))
p <- p + stat_function(fun = Vectorize(c.LG))
p <- p + xlim(-1.0, 5.0)
print(p)
person Severin Pappadeux    schedule 18.03.2016
comment
Это выглядит интересно... Мне потребуется некоторое время, чтобы отработать этот подход для моих данных (и выяснить, что такое квадратура), но я вернусь к этому посту, как только сделаю это. - person PeterFoster; 18.03.2016
comment
@PeterFoster хорошо. Это наборы весов/абсцисс для интегралов с exp(-x^2) или exp(-x) ядрами под знаком интегрирования. Может помочь с гауссовой сверткой, а также со сверткой с экспоненциальным членом в гамма-распределении. НО потребуется немного математики, чтобы правильно вырезать термины ядра - person Severin Pappadeux; 18.03.2016
comment
@PeterFoster немного подумав об этом, я бы сначала сделал гамму с логнормальным, получив exp член из гаммы и используя Гаусса-Лагерра. Гауссово через Гаусса-Эрмита будет последним - person Severin Pappadeux; 18.03.2016
comment
@ Северин П. Спасибо за совет; гамма + логнормальные компоненты являются доминирующими функциями в моих данных, поэтому я начну с них. Я мог бы быть в состоянии получить некоторые результаты к концу этой недели. - person PeterFoster; 21.03.2016