«-744.4401» постоянно отображается как вычисленные значения вероятности для функции r «optim» - PullRequest
0 голосов
/ 03 июня 2019

Я пытался использовать функцию «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")
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...