对广义伽马分布进行似然比检验

时间:2018-08-01 09:52:30

标签: r statistics

我的问题与“交叉验证”上的another topic有关。简而言之,我有三个参数伽玛分布,我正尝试为它们模拟威尔克斯统计量的抽样分布(使用似然比检验)。

对于广义伽玛分布,我使用的是gengamma.orig库中的函数flexsurv。我正在尝试进行tau统计量的似然比检验,然后对此进行1000次模拟。检验统计量(Wilks lambda)应该是df = 1的卡方分布。

我的R代码如下:

library(flexsurv)
library(fitdistrplus)
library(ggplot2)
set.seed(15)


# define parameters (random numbers, except tau_0)
lambda <- 0.2
scale  <- 1 / lambda # compute inverse value because of different parameterisation
shape  <- tau <- 1 # tau
k      <- a   <- 4 # a

# generate m = 1000 i.i.d. samples of size n = 1000
n <- 1000
m <- 1000

x <- matrix(rgengamma.orig(n*m, shape, scale, k), m, n)

# estimate parameters using MLE
x_params <- apply(x, 1, fitdist, distr="gengamma.orig", 
                   method='mle',
                   start=list(shape=shape, scale=scale,k=k), lower=c(0,0,0))

## generate distribution of test statistic

# function for logL
logL <- function(x, tau, a, lambda){
    n <- length(x)
    a*tau*n*log(lambda) + n*log(tau)-n*log(gamma(a)) + 
        (a*tau-1)*sum(log(x)) - (lambda^tau)*sum(x^tau)
}

wilks_lambda <- rep(NA, m) # initialize empty vector
for (i in 1:m){
    # get estimated parameter values
    lambda_est <- 1 / (unlist(lapply(x_params[i], function(x) x$estimate['scale'])))
    tau_est    <- unlist(lapply(x_params[i], function(x) x$estimate['shape']))
    a_est      <- unlist(lapply(x_params[i], function(x) x$estimate['k']))

    logL_H1 <- logL(x[i,], tau_est, a_est, lambda_est)
    logL_H0 <- logL(x[i,], tau, a_est, lambda_est)

    wilks_lambda[i] <- 2*(logL_H1 - logL_H0)

}

# plot sampling distribution of Wilks' lambda
wilks_lambda_d <- data.frame(statistic=wilks_lambda)
ggplot(wilks_lambda_d, aes(x=statistic)) +
    geom_histogram(aes(y=..density..),
                   color="black", fill="lightgrey", bindwidth=1) + 
    stat_function(aes(linetype="chisq"), 
                  fun = dchisq, size=1, alpha=0.8, 
                  args=list(df=1)) +
    theme(legend.position="none") + xlim(0,30)

现在的问题是,我没有得到威尔克斯定理所期望的卡方分布。相反,我得到以下分布(黑线是df = 1的卡方分布):

Wilks lambda distribution

附加说明:
(1)我不知道这是否重要,但是参数的MLE的采样分布对于a和lambda不是正常的,但是对于tau是正常的。
(2)该任务的要求是模拟大小为1000的样本。但是,我尝试模拟具有相同结果的不同数量的样本。
(3)我尝试使用以下代码对正态分布(H0:sigma = 1 vs. H1:sigma!= 1)进行相同的测试,结果看起来还不错-Wilks lambda的分布看起来像卡方分布(但是,我尚未进行过适合性的正式测试)。

library(flexsurv)
library(fitdistrplus)
library(ggplot2)
set.seed(15)

# define parameters
mu    = 5
sigma = 1

# generate m = 1000 i.i.d. samples of size n = 1000
n <- 1000
m <- 1000

x <- matrix(rnorm(n*m, mu, sigma), m, n)

# estimate parameters using MLE
x_params <- apply(x, 1, fitdist, distr="norm", 
                  method='mle',
                  start=list(mean=mu, sd=sigma), lower=c(0,0), upper=c(10,2))

# function for logL
logL <- function(x, mu, sigma){
    n <- length(x)
    logL <- -n * log(2*pi) / 2 - n * log(sigma) - sum(((x-mu)/sigma)^2)/2
    return(logL)
}


wilks_lambda <- rep(NA, m) # initialize empty vector

for (i in 1:m){
    # get estimated parameter values
    mu_est    <- unlist(lapply(x_params[i], function(x) x$estimate['mean']))
    sigma_est <- unlist(lapply(x_params[i], function(x) x$estimate['sd']))

    logL_H1 <- logL(x[i,], mu_est, sigma_est)
    logL_H0 <- logL(x[i,], mu_est, sigma)

    wilks_lambda[i] <- 2*(logL_H1 - logL_H0)
}

wilks_lambda_d <- data.frame(statistic=wilks_lambda)
ggplot(wilks_lambda_d, aes(x=statistic)) +
    geom_histogram(aes(y=..density..),
                   color="black", fill="lightgrey", bins=60) +
    stat_function(aes(linetype="chisq"), 
                  fun = dchisq, size=1, alpha=0.8, 
                  args=list(df=1)) +
    theme(legend.position="none")    

在这种情况下,还有威尔克斯·拉姆达的身影:

Distribution of Wilks' lambda for normal distribution

那么,我的实现正确吗?我最不确定for循环中的部分

0 个答案:

没有答案