Максимальное произведение расстояний с использованием R

Question

Я хотел бы оценить параметр для экспоненциального распределения, используя Максимальное произведение расстояний (MPS)Мне нужно будет минимизировать:

- (1 / (n + 1)) * (сумма log D [i] от i = 1 до n + 1),
где D [i] = F (x [i]) - F (x [i - 1])

И вот мой код R:

n<- 10
mydata<- rexp(n, rate=2)
x<- sort(mydata)

fnn<- function(lambda,x){
for (i in 2:n){
c<- 1-exp(-lambda*x[i])
d<- 1-exp(-lambda*x[i-1])
}
s<- (1/(n-1))*sum(log(c-d))
return(-s)
}

optim(0.8, fnn, x=x)

Может кто-нибудь проверить?правильно ли я здесь поступаю?

Вывод, который я получил, далек от истинного значения lambda = 2.

$`par`
[1] 0.92375

$value
[1] 0.1847188

$counts
function gradient 
      18       NA 

$convergence
[1] 0

$message
NULL

Какие модификации я должен включить?

Answer 1

Проблема с вашим кодом в том, что он переписывает c и d каждый раз через цикл for.Также была ошибка в вычислении мультипликативной константы 1/(n + 1).
Вот исправленная версия.Ключ заключается в том, чтобы зарезервировать память перед циклом с numeric(n - 1).
. Я также включил более простую версию, используя преимущества встроенного в R pexp.

fnn <- function(lambda, x){
  n <- length(x)
  c <- numeric(n - 1)
  d <- numeric(n - 1)
  for (i in 2:n){
    c[i - 1] <- 1 - exp(-lambda*x[i])
    d[i - 1] <- 1 - exp(-lambda*x[i-1])
  }
  s <- (1/(n + 1))*sum(log(c - d))
  return(-s)
}

fnn2 <- function(lambda, x){
  n <- length(x)
  D <- log(pexp(x[-1], rate = lambda,) - pexp(x[-n], rate = lambda))
  s <- sum(D)/(n + 1)
  -s
}


set.seed(1234)
n <- 10
mydata <- rexp(n, rate = 2)
x <- sort(mydata)

opt <- optim(0.8, fnn, x = x)

opt2 <- optim(0.8, fnn2, x = x)

opt$par
#[1] 2.9225
opt2$par
#[1] 2.9225

identical(opt$par, opt2$par)
#[1] TRUE

.