我的问题与“交叉验证”上的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的卡方分布):
附加说明:
(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")
在这种情况下,还有威尔克斯·拉姆达的身影:
那么,我的实现正确吗?我最不确定for循环中的部分