![](/img/trans.png)
[英]“R for Data Science” book (Wickham) . Cannot reproduce example
[英]Using optim() in R to reproduce results of Fisher's book about spherical data
我正在嘗試重現“球形數據的統計分析”的結果。 我想計算球面中位數(你可以看http://www.jstor.org/stable/2345577的公式,等式1,我不知道如何在這里正確地寫出來)。 我使用本書的B1數據集:
lat1=c(-26.4,-32.2,-73.1,-80.2,-71.1,-58.7,-40.8,-14.9,-66.1,-1.8,-52.1,-77.3,-68.8,-68.4,
-29.2,-78.5,-65.4,-49,-67,-56.7,-80.5,-77.7,-6.9,-59.4,-5.6,-62.6,-74.7,-65.3,-71.6,
-23.3,-74.3,-81,-12.7,-75.4,-85.9,-84.8,-7.4,-29.8,-85.2,-53.1,-38.3,-72.7,-60.2,-63.4,
-17.2,-81.6,-40.4,-53.6,-56.2,-75.1)
long1=c(324,163.7,51.9,140.5,267.2,32,28.1,266.3,144.3,256.2,83.2,182.1,110.4,142.2,246.3,222.6,247.7,
65.6,282.6,56.2,108.4,266,19.1,281.7,107.4,105.3,120.2,286.6,106.4,96.5,90.2,170.9,199.4,118.6,
63.7,74.9,93.8,72.8,113.2,51.5,146.8,103.1,33.2,154.8,89.9,295.6,41.0,59.1,35.6,70.7)
library('sphereplot')
B1=data.frame(long=long1,lat=lat1)
a=sph2car(B1$long,B1$lat)
x=a[,1]
y=a[,2]
z=a[,3]
我首先檢查數據:
sqrt(x^2+y^2+z^2)
data1=data.frame(x,y,z)
median.direction <- function(par, data1) {
sum(acos(par[1]*data1[,1]+par[2]*data1[,2]+par[3]*data1[,3]))
}
median.direction2=optim(par=c(0,0,0), fn=median.direction, data1=data1)
result1=car2sph(median.direction2$par[1],median.direction2$par[2],median.direction2$par[3])
result1
“對於實施例5.1的數據(組B1),球形中值方向是(緯度78.9°,長度98.4°)。”
我不知道我的錯誤在哪里:
我必須和sph2car使用合作嗎? 優化是否與警告表現良好?
編輯:
這里有幾件事情。
首先,當數據集中的所有緯度都小於0時,很難看出緯度中位數是+ 79°。所以要么你的問題中有一個拼寫錯誤,要么教科書中有錯誤。
其次,您的數據集中在一個極點附近(或多或少)。 在這種情況下,您估計經度的能力本身就會受到影響。 考慮所有數據都在緯度-90°的極端情況。 然后中位數緯度恰好是-90°,但我們對經度中位數一無所知。 所以你的優化問題是經度有一個“淺層最小”(在這個數據集中)。 也就是說,有許多經度與你的目標函數最小化非常接近。 這是一個問題,因為大多數優化器使用局部最小化器 - 它們在接近初始估計的目標函數中尋求最小值。 因此,您得到的答案將取決於您的起點。
第三,鑒於上述情況,您最好使用更強大的優化器(IMO)。 在下面的示例中,我使用nloptr
包中的nloptr(...)
。 它使用起來有點困難,但結果對初始估計的敏感度較低。
為了證明這個問題,下面的代碼運行最小化100次,每次都有一個隨機選擇的起始點,並繪制數據和100“最小值”。
library(sphereplot)
library(nloptr)
f <- function(par, data1) {
sum(acos(par[1]*data1[,1]+par[2]*data1[,2]+par[3]*data1[,3]))
}
opts <- list(algorithm="NLOPT_GN_ISRES",xtol_rel=1.0e-6, maxeval=10000)
# set up the plot
rgl.sphgrid()
points3d(x,y,z, col="red",size=5)
set.seed(1) # for reproducibility
# 100 initial estimates, randomly distributed on the sphere
N <- 100
xyz.init <- sph2car(long=sample(-180:180,N),lat=sample(-90:90,N))
get.median <- function(i) {
md <- nloptr(x0=xyz.init[i,],eval_f=f,
lb=c(-1,-1,-1), ub=c(1,1,1),
data1=data1, opts=opts)
xyz <- md$solution
lines3d(c(0,xyz[1]),c(0,xyz[2]),c(0,xyz[3]),col="green",lwd=2)
median <- car2sph(xyz[1],xyz[2],xyz[3])
cat(".") # cheap and dirty progress bar...
return(median)
}
sph.med <- do.call(rbind,lapply(1:nrow(xyz.init),get.median))
colMeans(sph.med)
# long lat radius
# 92.314309 -77.361522 0.998315
您可以看到優化創建了“中位數”估計的包絡(錐)。 所有這些估計的平均值非常接近書中的結果(除了緯度的符號)。
值得注意的是,盡管最多使用10,000次迭代,但優化通常不會收斂!
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.