การถดถอยเมื่อแต่ละจุดมีความไม่แน่นอนใน


12

ฉันทำวัดสองตัวแปรxและy ที่ พวกเขาทั้งสองได้รู้จักความไม่แน่นอนσ xและσ y ที่เกี่ยวข้องกับพวกเขา ฉันอยากพบความสัมพันธ์ระหว่างxและy ที่ ฉันจะทำมันได้อย่างไรnxyσxσyxy

แก้ไข : แต่ละมีที่แตกต่างกันσ x , ฉันที่เกี่ยวข้องกับมันและเช่นเดียวกันกับปีฉันxiσx,iyi


ตัวอย่าง R ที่ทำซ้ำได้:

## pick some real x and y values 
true_x <- 1:100
true_y <- 2*true_x+1

## pick the uncertainty on them
sigma_x <- runif(length(true_x), 1, 10) # 10
sigma_y <- runif(length(true_y), 1, 15) # 15

## perturb both x and y with noise 
noisy_x <- rnorm(length(true_x), true_x, sigma_x)
noisy_y <- rnorm(length(true_y), true_y, sigma_y)

## make a plot 
plot(NA, xlab="x", ylab="y",
    xlim=range(noisy_x-sigma_x, noisy_x+sigma_x), 
    ylim=range(noisy_y-sigma_y, noisy_y+sigma_y))
arrows(noisy_x, noisy_y-sigma_y, 
       noisy_x, noisy_y+sigma_y, 
       length=0, angle=90, code=3, col="darkgray")
arrows(noisy_x-sigma_x, noisy_y,
       noisy_x+sigma_x, noisy_y,
       length=0, angle=90, code=3, col="darkgray")
points(noisy_y ~ noisy_x)

## fit a line 
mdl <- lm(noisy_y ~ noisy_x)
abline(mdl)

## show confidence interval around line 
newXs <- seq(-100, 200, 1)
prd <- predict(mdl, newdata=data.frame(noisy_x=newXs), 
    interval=c('confidence'), level=0.99, type='response')
lines(newXs, prd[,2], col='black', lty=3)
lines(newXs, prd[,3], col='black', lty=3)

การถดถอยเชิงเส้นโดยไม่พิจารณาข้อผิดพลาดในตัวแปร

ปัญหากับตัวอย่างนี้ก็คือว่าผมคิดว่ามันสันนิษฐานว่ามีความไม่แน่นอนในไม่xฉันจะแก้ไขสิ่งนี้ได้อย่างไรx


lmYP(Y|X)YXX

1
สำหรับกรณีที่ค่อนข้างพิเศษของคุณ (univariate มีอัตราส่วนที่รู้จักกันของระดับเสียงสำหรับ X และ Y) เดมิงถดถอยจะทำเคล็ดลับเช่นDemingฟังก์ชั่นแพคเกจใน R MethComp
conjugateprior

1
@conjugateprior ขอบคุณนี้ดูมีแนวโน้ม ฉันสงสัยว่า: การถดถอย Deming ยังคงทำงานอยู่หรือไม่ถ้าฉันมีความแปรปรวน (แต่ยังคงทราบ) ที่แตกต่างกันในแต่ละ x และ y หรือไม่ นั่นคือถ้า x นั้นยาวและฉันใช้ไม้บรรทัดที่มีความแตกต่างกันเพื่อให้ได้ x แต่ละอัน
rhombidodecahedron

ฉันคิดว่าบางทีวิธีการแก้ไขเมื่อมีความแตกต่างกันสำหรับการวัดแต่ละครั้งใช้วิธีของยอร์ค ไม่มีใครรู้ว่ามีการใช้งานของวิธีการนี้หรือไม่?
rhombidodecahedron

1
@rhombidodecahedron ดู "ด้วยข้อผิดพลาดที่วัดได้" พอดีในคำตอบของฉันที่นั่น: stats.stackexchange.com/questions/174533/… (ซึ่งนำมาจากเอกสารของแพ็คเกจ deming)
Roland

คำตอบ:


9

Lθγ

(x,y):cos(θ)x+sin(θ)y=γ.

(x,y)

d(x,y;L)=cos(θ)x+sin(θ)yγ.

xiσi2yiτi2xiyi

Var(d(xi,yi;L))=cos2(θ)σi2+sin2(θ)τi2.

θγ

σiτi0


τiσixn=8

รูป

เส้นที่แท้จริงจะแสดงเป็นสีน้ำเงินประ จุดเดิมจะถูกพล็อตเป็นวงกลม ลูกศรสีเทาเชื่อมต่อพวกเขาไปยังจุดที่สังเกตได้ซึ่งถูกพล็อตเป็นดิสก์สีดำทึบ การแก้ปัญหาจะถูกวาดเป็นเส้นสีแดงทึบ แม้จะมีการเบี่ยงเบนขนาดใหญ่ระหว่างค่าที่ตรวจพบและค่าจริง แต่การแก้ปัญหาก็อยู่ใกล้กับเส้นที่ถูกต้องภายในภูมิภาคนี้อย่างน่าทึ่ง

#
# Generate data.
#
theta <- c(1, -2, 3) # The line is theta %*% c(x,y,-1) == 0
theta[-3] <- theta[-3]/sqrt(crossprod(theta[-3]))
n <- 8
set.seed(17)
sigma <- rexp(n, 1/2)
tau <- rexp(n, 1)
u <- 1:n
xy.0 <- t(outer(c(-theta[2], theta[1]), 0:(n-1)) + c(theta[3]/theta[1], 0))
xy <- xy.0 + cbind(rnorm(n, sd=sigma), rnorm(n, sd=tau))
#
# Fit a line.
#
x <- xy[, 1]
y <- xy[, 2]
f <- function(phi) { # Negative log likelihood, up to an additive constant
  a <- phi[1]
  gamma <- phi[2]
  sum((x*cos(a) + y*sin(a) - gamma)^2 / ((sigma*cos(a))^2 + (tau*sin(a))^2))/2
}
fit <- lm(y ~ x) # Yields starting estimates
slope <- coef(fit)[2]
theta.0 <- atan2(1, -slope)
gamma.0 <- coef(fit)[1] / sqrt(1 + slope^2)
sol <- nlm(f,c(theta.0, gamma.0))
#
# Plot the data and the fit.
#
theta.hat <- sol$estimate[1] %% (2*pi)
gamma.hat <- sol$estimate[2]
plot(rbind(xy.0, xy), type="n", xlab="x", ylab="y")
invisible(sapply(1:n, function(i) 
  arrows(xy.0[i,1], xy.0[i,2], xy[i,1], xy[i,2], 
         length=0.15, angle=20, col="Gray")))
points(xy.0)
points(xy, pch=16)
abline(c(theta[3] / theta[2], -theta[1]/theta[2]), col="Blue", lwd=2, lty=3)
abline(c(gamma.hat / sin(theta.hat), -1/tan(theta.hat)), col="Red", lwd=2)

+1 เท่าที่ผมเข้าใจคำตอบนี้นี้เก่าเกินไป Q: stats.stackexchange.com/questions/178727 ? เราควรปิดมันซ้ำซ้อนกัน
อะมีบากล่าวว่า Reinstate Monica

นอกจากนี้ตามความคิดเห็นของฉันต่อคำตอบในหัวข้อนั้นดูเหมือนว่าdemingฟังก์ชั่นสามารถจัดการข้อผิดพลาดตัวแปรด้วย มันน่าจะให้ผลที่พอดีกับคุณมาก
อะมีบากล่าวว่า Reinstate Monica

ฉันสงสัยว่าการสนทนามีความเหมาะสมหรือไม่หากคุณเปลี่ยนตำแหน่งของวรรค 2 ด้านบนและด้านล่างของรูป?
gung - Reinstate Monica

3
ผมนึกถึงช่วงเช้าวันนี้ (โดยผู้มีสิทธิเลือกตั้ง) ว่าคำถามนี้ได้รับการถามและตอบในหลายวิธีที่มีรหัสการทำงานหลายปีที่ผ่านมาบนเว็บไซต์ Mathematica SE
whuber

โซลูชันนี้มีชื่อหรือไม่ และอาจเป็นแหล่งข้อมูลสำหรับการอ่านเพิ่มเติม (นอกเหนือจากเว็บไซต์ Mathematica SE)
JustGettin เริ่ม

0

การเพิ่มประสิทธิภาพความน่าจะเป็นสูงสุดสำหรับกรณีความไม่แน่นอนใน x และ y ได้รับการแก้ไขโดย York (2004) นี่คือรหัส R สำหรับฟังก์ชั่นของเขา

"YorkFit" เขียนโดย Rick Wehr, 2011 แปลเป็น R โดย Rachel Chang

ชุดคำสั่งแบบสากลสำหรับการค้นหาเส้นตรงที่ดีที่สุดพอดีกับข้อมูลที่มีตัวแปรข้อผิดพลาดที่สัมพันธ์กันรวมถึงข้อผิดพลาดและความดีของการประมาณพอดี (13) ของ York 2004, American Journal of Physics ซึ่งมีพื้นฐานมาจาก York 1969, ตัวอักษรวิทยาศาสตร์โลกและดาวเคราะห์

YorkFit <- ฟังก์ชั่น (X, Y, Xstd, Ystd, Ri = 0, b0 = 0, printCoefs = 0, makeLine = 0, eps = 1e-7)

X, Y, Xstd, Ystd: คลื่นที่มีจุด X, Y points และส่วนเบี่ยงเบนมาตรฐาน

คำเตือน: Xstd และ Ystd ไม่สามารถเป็นศูนย์ได้ซึ่งจะทำให้ Xw หรือ Yw เป็น NaN ใช้ค่าน้อยมากแทน

Ri: สัมประสิทธิ์สหสัมพันธ์สำหรับข้อผิดพลาด X และ Y - ความยาว 1 หรือความยาวของ X และ Y

b0: การคาดเดาเบื้องต้นสำหรับความลาดชัน (สามารถรับได้จากมาตรฐานกำลังสองน้อยที่สุดที่ไม่มีข้อผิดพลาด)

printCoefs: ตั้งค่าเท่ากับ 1 เพื่อแสดงผลลัพธ์ในหน้าต่างคำสั่ง

makeLine: ตั้งค่าเท่ากับ 1 เพื่อสร้างคลื่น Y สำหรับเส้นพอดี

ส่งคืนเมทริกซ์ที่มีค่าตัดและความชันบวกความไม่แน่นอน

หากไม่มีการคาดเดาเริ่มต้นสำหรับ b0 ให้ใช้ OLS ถ้า (b0 == 0) {b0 = lm (Y ~ X) $ สัมประสิทธิ์ [2]}

tol = abs(b0)*eps #the fit will stop iterating when the slope converges to within this value

a, b: การสกัดกั้นขั้นสุดท้ายและความชัน a.err, b.err: ความไม่แน่นอนโดยประมาณในการสกัดกั้นและความชัน

# WAVE DEFINITIONS #

Xw = 1/(Xstd^2) #X weights
Yw = 1/(Ystd^2) #Y weights


# ITERATIVE CALCULATION OF SLOPE AND INTERCEPT #

b = b0
b.diff = tol + 1
while(b.diff>tol)
{
    b.old = b
    alpha.i = sqrt(Xw*Yw)
    Wi = (Xw*Yw)/((b^2)*Yw + Xw - 2*b*Ri*alpha.i)
    WiX = Wi*X
    WiY = Wi*Y
    sumWiX = sum(WiX, na.rm = TRUE)
    sumWiY = sum(WiY, na.rm = TRUE)
    sumWi = sum(Wi, na.rm = TRUE)
    Xbar = sumWiX/sumWi
    Ybar = sumWiY/sumWi
    Ui = X - Xbar
    Vi = Y - Ybar

    Bi = Wi*((Ui/Yw) + (b*Vi/Xw) - (b*Ui+Vi)*Ri/alpha.i)
    wTOPint = Bi*Wi*Vi
    wBOTint = Bi*Wi*Ui
    sumTOP = sum(wTOPint, na.rm=TRUE)
    sumBOT = sum(wBOTint, na.rm=TRUE)
    b = sumTOP/sumBOT

    b.diff = abs(b-b.old)
  }     

   a = Ybar - b*Xbar
   wYorkFitCoefs = c(a,b)

# ERROR CALCULATION #

Xadj = Xbar + Bi
WiXadj = Wi*Xadj
sumWiXadj = sum(WiXadj, na.rm=TRUE)
Xadjbar = sumWiXadj/sumWi
Uadj = Xadj - Xadjbar
wErrorTerm = Wi*Uadj*Uadj
errorSum = sum(wErrorTerm, na.rm=TRUE)
b.err = sqrt(1/errorSum)
a.err = sqrt((1/sumWi) + (Xadjbar^2)*(b.err^2))
wYorkFitErrors = c(a.err,b.err)

# GOODNESS OF FIT CALCULATION #
lgth = length(X)
wSint = Wi*(Y - b*X - a)^2
sumSint = sum(wSint, na.rm=TRUE)
wYorkGOF = c(sumSint/(lgth-2),sqrt(2/(lgth-2))) #GOF (should equal 1 if assumptions are valid), #standard error in GOF

# OPTIONAL OUTPUTS #

if(printCoefs==1)
 {
    print(paste("intercept = ", a, " +/- ", a.err, sep=""))
    print(paste("slope = ", b, " +/- ", b.err, sep=""))
  }
if(makeLine==1)
 {
    wYorkFitLine = a + b*X
  }
 ans=rbind(c(a,a.err),c(b, b.err)); dimnames(ans)=list(c("Int","Slope"),c("Value","Sigma"))
return(ans)
 }

นอกจากนี้โปรดทราบว่าแพ็คเกจ R "IsoplotR" มีฟังก์ชั่น york () ซึ่งให้ผลลัพธ์เหมือนกับรหัส YorkFit ที่นี่
Steven
โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.