คำนวณความน่าจะเป็นบันทึก“ ด้วยมือ” สำหรับการถดถอยแบบไม่เชิงเส้นกำลังสองน้อยที่สุด (nlme)

ฉันกำลังพยายามคำนวณความน่าจะเป็นในการบันทึกสำหรับการถดถอยกำลังสองน้อยที่สุดแบบไม่เชิงเส้นสำหรับฟังก์ชันปรับโดยฟังก์ชั่นในแพคเกจ R โดยใช้เมทริกซ์ความแปรปรวนร่วมแปรปรวนที่สร้างขึ้นโดยระยะทางบนต้นไม้สายวิวัฒนาการที่สมมติว่ามีการเคลื่อนที่แบบบราวเนียน ( จากแพ็คเกจ) รหัส R ที่สามารถทำซ้ำได้ดังต่อไปนี้เหมาะกับรุ่น gnls โดยใช้ข้อมูล x, y และแผนภูมิแบบสุ่มที่มี 9 แท็กซ่า:$f(x)=\frac{\beta_1}{(1+\frac x\beta_2)^{\beta_3}}$gnlsnlmecorBrownian(phy=tree)ape

require(ape)
require(nlme)
require(expm)
tree <- rtree(9)
x <- c(0,14.51,32.9,44.41,86.18,136.28,178.21,262.3,521.94)
y <- c(100,93.69,82.09,62.24,32.71,48.4,35.98,15.73,9.71)
data <- data.frame(x,y,row.names=tree$tip.label)
model <- y~beta1/((1+(x/beta2))^beta3)
f=function(beta,x) beta[1]/((1+(x/beta[2]))^beta[3])
start <- c(beta1=103.651004,beta2=119.55067,beta3=1.370105)
correlation <- corBrownian(phy=tree)
fit <- gnls(model=model,data=data,start=start,correlation=correlation)
logLik(fit) 

ผมอยากจะคำนวณความน่าจะเข้าสู่ระบบ "ด้วยมือ" (ใน R แต่ไม่มีการใช้logLikฟังก์ชั่น) ตามประมาณค่าพารามิเตอร์ที่ได้รับจากเพื่อให้ตรงกับการส่งออกจากgnls logLik(fit)หมายเหตุ: ฉันไม่ได้พยายามประมาณพารามิเตอร์ ฉันแค่ต้องการคำนวณความน่าจะเป็นบันทึกของพารามิเตอร์ที่ประมาณโดยgnlsฟังก์ชัน (แม้ว่าบางคนมีตัวอย่างที่ทำซ้ำได้ของวิธีการประมาณพารามิเตอร์โดยไม่ต้องgnlsฉันจะสนใจดูมัน!)

ฉันไม่แน่ใจว่าจะทำสิ่งนี้ได้อย่างไรในอาร์สัญกรณ์พีชคณิตเชิงเส้นที่อธิบายไว้ในตัวแบบผสมเอฟเฟกต์ใน S และ S-Plus (Pinheiro และ Bates) นั้นเหนือกว่าหัวของฉันมากและไม่มีความพยายามlogLik(fit)ใด ๆ นี่คือรายละเอียดที่อธิบายโดย Pinheiro และ Bates:

บันทึกความเป็นไปได้สำหรับโมเดลกำลังสองแบบไม่เชิงเส้นทั่วไป โดยที่ถูกคำนวณดังนี้:$y_i=f_i(\phi_i,v_i)+\epsilon_i$$\phi_i=A_i\beta$

$l(\beta,\sigma^2,\delta|y)=-\frac 12 \Bigl\{ N\log(2\pi\sigma^2)+\sum\limits_{i=1}^M{\Bigl[\frac{||y_i^*-f_i^*(\beta)||^2}{\sigma^2}+\log|\Lambda_i|\Bigl]\Bigl\}}$

ที่คือจำนวนของการสังเกตและv_i)$N$$f_i^*(\beta)=f_i^*(\phi_i,v_i)$

$\Lambda_i$เป็นบวกแน่นอน,และ$y_i^*=\Lambda_i^{-T/2}y_i$$f_i^*(\phi_i,v_i)=\Lambda_i^{-T/2}f_i(\phi_i,v_i)$

สำหรับและคงที่ตัวประมาณค่า ML ของคือ$\beta$$\lambda$$\sigma^2$

$\hat\sigma(\beta,\lambda)=\sum\limits_{i=1}^M||y_i^*-f_i^*(\beta)||^2 / N$

และประวัติความเป็นไปได้ที่บันทึกไว้คือ

$l(\beta,\lambda|y)=-\frac12\Bigl\{N[\log(2\pi/N)+1]+\log\Bigl(\sum\limits_{i=1}^M||y_i^*-f_i^*(\beta)||^2\Bigl)+\sum\limits_{i=1}^M\log|\Lambda_i|\Bigl\}$

ซึ่งจะใช้กับอัลกอริทึม Gauss-Seidel เพื่อหาสิ่งที่ประมาณการ ML ของและ\ใช้การประมาณที่แคบลงของ :$\beta$$\lambda$$\sigma^2$

$\sigma^2=\sum\limits_{i=1}^M\Bigl|\Bigl|\hat\Lambda_i^{-T/2}[y_i-f_i(\hat\beta)]\Bigl|\Bigl|^2/(N-p)$

ที่หมายถึงความยาวของ\$p$$\beta$

ฉันได้รวบรวมรายการคำถามเฉพาะที่ฉันพบ:

1. คืออะไร ? มันเป็นเมทริกซ์ระยะทางที่ผลิตโดยในหรือไม่ก็จะต้องมีการเปลี่ยนอย่างใดหรือแปรโดยหรือสิ่งอื่นทั้งหมด?$\Lambda_i$big_lambda <- vcv.phylo(tree)ape$\lambda$
2. หากว่า BE หรือสมการสำหรับการประมาณการลำเอียงน้อย (สมการที่ผ่านมาในโพสต์นี้)?$\sigma^2$fit$sigma^2
3. จำเป็นหรือไม่ที่จะต้องใช้เพื่อคำนวณความน่าจะเป็นของล็อกหรือเป็นเพียงขั้นตอนกลางสำหรับการประมาณค่าพารามิเตอร์? นอกจากนี้ยังเป็นวิธีที่ใช้? มันเป็นค่าเดียวหรือเวกเตอร์และมันถูกคูณด้วยหรือแค่องค์ประกอบนอกแนวทแยงมุม ฯลฯ ?$\lambda$$\lambda$$\Lambda_i$
4. คืออะไร? จะอยู่ในแพ็คเกจหรือไม่ ถ้าเป็นเช่นนั้นฉันสับสนเกี่ยวกับวิธีการคำนวณผลรวมเนื่องจากคืนค่าเดียวไม่ใช่ เวกเตอร์M ∑ i = 1 | | y ∗ i - f ∗ i ( β ) | | $||y-f(\beta)||$norm(y-f(fit$coefficients,x),"F")Matrix$\sum\limits_{i=1}^M||y_i^*-f_i^*(\beta)||^2$norm()
5. วิธีหนึ่งคำนวณ? มันเป็นเรื่องที่เป็นหรือมันคือจากแพคเกจ? ถ้าเป็นเช่นนั้นเราจะหาผลรวมของเมทริกซ์ได้อย่างไร (หรือมันบอกเป็นนัยว่ามันเป็นเพียงองค์ประกอบในแนวทแยงมุม)Λ $\log|\Lambda_i|$log(diag(abs(big_lambda)))big_lambda$\Lambda_i$logm(abs(big_lambda))expmlogm()
6. เพียงเพื่อยืนยันการเป็นคำนวณเช่นนี้?$\Lambda_i^{-T/2}$t(solve(sqrtm(big_lambda)))
7. วิธีการที่และคำนวณอย่างไร มันเป็นอย่างใดอย่างหนึ่งต่อไปนี้: f ∗ ฉัน ( β $y_i^*$$f_i^*(\beta)$

y_star <- t(solve(sqrtm(big_lambda))) %*% y

และ

f_star <- t(solve(sqrtm(big_lambda))) %*% f(fit$coefficients,x)

หรือมันจะเป็น

y_star <- t(solve(sqrtm(big_lambda))) * y

และ

f_star <- t(solve(sqrtm(big_lambda))) * f(fit$coefficients,x) ?

logLik(fit)หากทุกคำถามเหล่านี้มีคำตอบในทางทฤษฎีผมคิดว่าน่าจะเข้าสู่ระบบควรจะคำนวณเพื่อให้ตรงกับการส่งออกจาก ความช่วยเหลือใด ๆ ของคำถามเหล่านี้จะได้รับการชื่นชมอย่างมาก หากมีสิ่งใดที่ต้องการคำชี้แจงกรุณาแจ้งให้เราทราบ ขอบคุณ!

UPDATE : ฉันได้ทดลองกับความเป็นไปได้ต่าง ๆ สำหรับการคำนวณความน่าจะเป็นและนี่คือสิ่งที่ดีที่สุดที่ฉันได้ค้นพบ logLik_calcประมาณ 1 ถึง 3 จากค่าที่ส่งคืนโดยlogLik(fit)สม่ำเสมอ ไม่ว่าฉันจะใกล้เคียงกับการแก้ปัญหาจริงหรือนี่คือความบังเอิญ ความคิดใด ๆ

  C <- vcv.phylo(tree) # variance-covariance matrix
  tC <- t(solve(sqrtm(C))) # C^(-T/2)
  log_C <- log(diag(abs(C))) # log|C|
  N <- length(y)
  y_star <- tC%*%y 
  f_star <- tC%*%f(fit$coefficients,x)
  dif <- y_star-f_star  
  sigma_squared <-  sum(abs(y_star-f_star)^2)/N
  # using fit$sigma^2 also produces a slightly different answer than logLik(fit)
  logLik_calc <- -((N*log(2*pi*(sigma_squared)))+
       sum(((abs(dif)^2)/(sigma_squared))+log_C))/2

เริ่มจากกรณีที่ง่ายกว่าโดยที่ไม่มีโครงสร้างความสัมพันธ์กับส่วนที่เหลือ:

fit <- gnls(model=model,data=data,start=start)
logLik(fit)

โอกาสในการบันทึกนั้นสามารถคำนวณด้วยมือได้อย่างง่ายดายด้วย:

N <- fit$dims$N
p <- fit$dims$p
sigma <- fit$sigma * sqrt((N-p)/N)
sum(dnorm(y, mean=fitted(fit), sd=sigma, log=TRUE))

เนื่องจากส่วนที่เหลือมีความเป็นอิสระเราจึงสามารถใช้dnorm(..., log=TRUE)เพื่อรับเงื่อนไขความเป็นไปได้ของบันทึกแต่ละรายการ (จากนั้นจึงสรุปผลรวม) หรือเราสามารถใช้:

sum(dnorm(resid(fit), mean=0, sd=sigma, log=TRUE))

โปรดทราบว่าfit$sigmaไม่ใช่ "การประมาณค่าที่ลำเอียงน้อยกว่า " - ดังนั้นเราต้องทำการแก้ไขด้วยตนเองก่อน$\sigma^2$

ตอนนี้สำหรับกรณีที่ซับซ้อนมากขึ้นซึ่งส่วนที่เหลือมีความสัมพันธ์:

fit <- gnls(model=model,data=data,start=start,correlation=correlation)
logLik(fit)

ที่นี่เราจำเป็นต้องใช้การแจกแจงแบบปกติหลายตัวแปร ฉันแน่ใจว่ามีฟังก์ชั่นสำหรับบางที่ แต่ลองทำด้วยมือ:

N <- fit$dims$N
p <- fit$dims$p
yhat <- cbind(fitted(fit))
R <- vcv(tree, cor=TRUE)
sigma <- fit$sigma * sqrt((N-p)/N)
S <- diag(sigma, nrow=nrow(R)) %*% R %*% diag(sigma, nrow=nrow(R))
-1/2 * log(det(S)) - 1/2 * t(y - yhat) %*% solve(S) %*% (y - yhat) - N/2 * log(2*pi)