θ^N
minθ∈ΘN−1∑i=1Nq(wi,θ)
θ^NΘH^
N−1∑Ni=1q(wi,θ)θ0
minθ∈ΘEq(w,θ).
N−1∑Ni=1q(wi,θ)Θ
Selanjutnya dalam bukunya Wooldridge memberikan contoh perkiraan Hessian yang dijamin pasti positif secara numerik. Dalam praktiknya, kepastian non-positif Hessian harus menunjukkan bahwa solusi berada pada titik batas atau algoritma gagal menemukan solusi. Yang biasanya merupakan indikasi lebih lanjut bahwa model yang dipasang mungkin tidak sesuai untuk data yang diberikan.
Ini adalah contoh angka. Saya menghasilkan masalah kuadrat terkecil non-linear:
yi=c1xc2i+εi
X[1,2]εσ2set.seed(3)
xiyi
Saya memilih fungsi fungsi kuadrat dari fungsi objektif kuadrat terkecil non-linear biasa:
q(w,θ)=(y−c1xc2i)4
Berikut adalah kode dalam R untuk mengoptimalkan fungsi, gradien dan hessiannya.
##First set-up the epxressions for optimising function, its gradient and hessian.
##I use symbolic derivation of R to guard against human error
mt <- expression((y-c1*x^c2)^4)
gradmt <- c(D(mt,"c1"),D(mt,"c2"))
hessmt <- lapply(gradmt,function(l)c(D(l,"c1"),D(l,"c2")))
##Evaluate the expressions on data to get the empirical values.
##Note there was a bug in previous version of the answer res should not be squared.
optf <- function(p) {
res <- eval(mt,list(y=y,x=x,c1=p[1],c2=p[2]))
mean(res)
}
gf <- function(p) {
evl <- list(y=y,x=x,c1=p[1],c2=p[2])
res <- sapply(gradmt,function(l)eval(l,evl))
apply(res,2,mean)
}
hesf <- function(p) {
evl <- list(y=y,x=x,c1=p[1],c2=p[2])
res1 <- lapply(hessmt,function(l)sapply(l,function(ll)eval(ll,evl)))
res <- sapply(res1,function(l)apply(l,2,mean))
res
}
Tes pertama bahwa gradien dan goni berfungsi seperti yang diiklankan.
set.seed(3)
x <- runif(10,1,2)
y <- 0.3*x^0.2
> optf(c(0.3,0.2))
[1] 0
> gf(c(0.3,0.2))
[1] 0 0
> hesf(c(0.3,0.2))
[,1] [,2]
[1,] 0 0
[2,] 0 0
> eigen(hesf(c(0.3,0.2)))$values
[1] 0 0
xy
> df <- read.csv("badhessian.csv")
> df
x y
1 1.168042 0.3998378
2 1.807516 0.5939584
3 1.384942 3.6700205
4 1.327734 -3.3390724
5 1.602101 4.1317608
6 1.604394 -1.9045958
7 1.124633 -3.0865249
8 1.294601 -1.8331763
9 1.577610 1.0865977
10 1.630979 0.7869717
> x <- df$x
> y <- df$y
> opt <- optim(c(1,1),optf,gr=gf,method="BFGS")
> opt$par
[1] -114.91316 -32.54386
> gf(opt$par)
[1] -0.0005795979 -0.0002399711
> hesf(opt$par)
[,1] [,2]
[1,] 0.0002514806 -0.003670634
[2,] -0.0036706345 0.050998404
> eigen(hesf(opt$par))$values
[1] 5.126253e-02 -1.264959e-05
Gradien adalah nol, tetapi goni itu tidak positif.
Catatan: Ini adalah upaya ketiga saya untuk memberikan jawaban. Saya berharap saya akhirnya berhasil memberikan pernyataan matematika yang tepat, yang menghindari saya di versi sebelumnya.