Регресія, коли кожна точка має свою невизначеність як у

Я зробив вимірювань двох змінних і . Вони обоє мають відомі невизначеності та пов'язані з ними. Я хочу знайти співвідношення між і . Як я можу це зробити?x y σ x σ y x $n$$x$$y$$\sigma_x$$\sigma_y$$x$$y$

EDIT : кожен має різні пов'язані з ним, і те ж саме, що і .σ x , $x_i$$\sigma_{x,i}$$y_i$

Приклад відтворення 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$

Нехай істинна лінія , задана кутом та значення , є множиноюθ $L$$\theta$$\gamma$

Підписана відстань між будь-якою точкою і цією лінією$(x,y)$

дисперсія буде а буде , незалежність та означає, що дисперсія цієї відстані дорівнюєσ 2 i y i τ 2 i x i y $x_i$$\sigma_i^2$$y_i$$\tau_i^2$$x_i$$y_i$

Отже, знайдемо і для яких обернена зважена на дисперсію сума квадратичних відстаней є якомога меншою: це буде рішенням максимальної ймовірності, якщо припустити, що помилки мають нормальний розподіл. Для цього потрібне числове рішення, але знайти його просто за допомогою декількох кроків Ньютона-Рафсона, що починаються зі значення, запропонованого звичайним найменшим квадратом.$\theta$$\gamma$

Симулятори дозволяють припустити, що це рішення добре навіть при малій кількості даних та відносно великих значеннях та . Звичайно, ви можете отримати стандартні помилки для параметрів звичайними способами. Якщо вас зацікавила стандартна помилка положення лінії, а також нахил, то, можливо, спочатку слід зосередити обидві змінні на : це повинно усунути майже всю кореляцію між оцінками двох параметрів.τ i$\sigma_i$$\tau_i$$0$

Метод настільки добре працює на прикладі запитання, що пристосована лінія майже відрізняється від справжньої лінії на ділянці: вони скрізь знаходяться в межах однієї одиниці або близько того. Натомість у цьому прикладі з експоненціального розподілу, а з експоненціального розподілу з подвоєною шкалою (так що більшість помилок, як правило, трапляється в координаті ). Є лише балів, невелика кількість. Справжні точки однаково розташовані вздовж лінії з одиничними проміжками. Це досить важкий тест, оскільки потенційні помилки помітні порівняно з діапазоном балів.σ i x n = $\tau_i$$\sigma_i$$x$$n=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)

Максимальна ймовірність оптимізації для випадку невизначеностей у x та y була розглянута Йорком (2004). Ось код R для його функції.

"YorkFit", написаний Ріком Вером, 2011 рік, перекладений на R Рейчел Чанг

Універсальний розпорядок пошуку найкращого прямого підходу до даних із змінними, корельованими помилками, включаючи похибки та корисність оцінок відповідності, дотримуючись рівняння (13) Йорка 2004 р., Американський журнал фізики, який базувався на Йорку 1969 р., Листи про Землю та планетарні науки

YorkFit <- функція (X, Y, Xstd, Ystd, Ri = 0, b0 = 0, printCoefs = 0, makeLine = 0, eps = 1e-7)

X, Y, Xstd, Ystd: хвилі, що містять точки X, точки Y та їхні стандартні відхилення

УВАГА: 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)
 }