Я пытался использовать функцию «optim» для вычисления mle, когда я запускаю последнюю часть
basis = get_mls_basis(1)
Lik1<-function(theta, basis){
theta0=theta[1]
theta1=theta[2]
L=log(theta0^(-n/2)*theta1^(-
sum(basis/2))*exp(-0.5/theta0*sum(e2/theta1^basis)))
return(L)
}
optim(c(1,1),Lik1,basis=basis,method = "Nelder-Mead")
несколько раз значение $ будет показывать "-744.4401" очень часто. Я не уверен, что MLE, сгенерированный в этой ситуации, действителен, мне кажется, система достигает предела вычислений.
set.seed(77885566)
X = matrix(runif(225),ncol=1)
e2 = matrix(runif(225,-1,1),ncol=1)
set.seed(123)
n=225
get_mls_basis<- function(p){
depth <- ceiling(runif(1)*p)
knot <- matrix(rep(0,depth+1),ncol=1)
lr <- runif(1) > 0.5
x <- matrix(rep(0,n),ncol=1)
not_finished <- 1
while (not_finished == 1) {
data_indx = ceiling(runif(1)*n)
var = matrix(rep(0,depth),ncol=1)
for (j in 1:depth) {
not_ok <- 1
while (not_ok == 1) {
ind <- ceiling(runif(1)*p)
if (!is.element (ind,var[1:j]))
{
var[j] <- ind
not_ok <- 0
}
}
}
x_v <- as.matrix(X[data_indx, var])
knot[1:depth] <- rgamma(depth,1,1)
knot[1:depth] <- knot[1:depth] / sqrt(sum(knot^2))
knot[depth+1] <- -x_v %*% knot[1:depth]
ones <- matrix(rep(1,n),ncol=1)
temp <- as.matrix(cbind(X[,var], ones)) %*% knot
if (lr == 0) {
for (i in 1:n)
{
temp[i] <- max(0,temp[i])
}
}
else {
for (i in 1:n)
{
temp[i] <- min(0,temp[i])
}
}
x <- temp
not_finished <- all(x==0)
}
x
}
basis = get_mls_basis(1)
Lik1<-function(theta, basis){
theta0=theta[1]
theta1=theta[2]
L=log(theta0^(-n/2)*theta1^(-
sum(basis/2))*exp(-0.5/theta0*sum(e2/theta1^basis)))
return(L)
}
optim(c(1,1),Lik1,basis=basis,method = "Nelder-Mead")