27 votos

Correlación entre los estimadores OLS para el intercepto y la pendiente

En un modelo de regresión simple,

$$ y = \beta_0 + \beta_1 x + \varepsilon, $$

los estimadores OLS $\hat{\beta}_0^{OLS}$ y $\hat{\beta}_1^{OLS}$ están correlacionados.

La fórmula para la correlación entre los dos estimadores es (si la he deducido correctamente):

$$ \operatorname{Corr}(\hat{\beta}_0^{OLS},\hat{\beta}_1^{OLS}) = \frac{-\sum_{i=1}^{n}x_i}{\sqrt{n} \sqrt{\sum_{i=1}^{n}x_i^2} }. $$

Preguntas:

  1. ¿Cuál es la explicación intuitiva de la presencia de la correlación?
  2. ¿Tiene la presencia de correlación alguna implicación importante?

El puesto era editado y se ha eliminado la afirmación de que la correlación desaparece con el tamaño de la muestra. (Gracias a @whuber y @ChristophHanck).

20voto

Silverfish Puntos 6909

Puede que le guste seguir a Dougherty Introducción a la econometría , tal vez considerando por ahora que $x$ es una variable no estocástica, y definiendo la desviación media cuadrática de $x$ para ser $\DeclareMathOperator{\MSD}{MSD}\MSD(x) = \frac{1}{n} \sum_{i=1}^n (x_i - \bar{x})^2$ . Tenga en cuenta que la DMS se mide en el cuadrado de las unidades de $x$ (por ejemplo, si $x$ está en $\text{cm}$ entonces el MSD está en $\text{cm}^2$ ), mientras que la desviación media cuadrática, $\DeclareMathOperator{\RMSD}{RMSD}\RMSD(x)=\sqrt{\MSD(x)}$ está en la escala original. Esto da como resultado

$$\DeclareMathOperator{\Corr}{Corr}\Corr(\hat{\beta}_0^{OLS},\hat{\beta}_1^{OLS}) = \frac{-\bar{x}}{\sqrt{\MSD(x) + \bar{x}^2}}$$

Esto debería ayudarte a ver cómo la correlación se ve afectada tanto por el media de $x$ (en particular, la correlación entre sus estimadores de pendiente e intercepción se elimina si el $x$ centrado de la variable) y también por su difundir . (¡Esta descomposición también podría haber hecho más evidente la asintótica!)

Voy a reiterar la importancia de este resultado: si $x$ no tiene media cero, podemos transformarlo restando $\bar{x}$ para que ahora esté centrado. Si ajustamos una línea de regresión de $y$ en $x - \bar{x}$ las estimaciones de la pendiente y el intercepto no están correlacionadas: una subestimación o sobreestimación en una no tiende a producir una subestimación o sobreestimación en la otra. Pero esta línea de regresión es simplemente una traducción de la $y$ en $x$ ¡línea de regresión! El error estándar del intercepto de la $y$ en $x - \bar{x}$ es simplemente una medida de incertidumbre de $\hat y$ cuando su variable traducida $x - \bar x = 0$ cuando esa línea se traslada a su posición original, vuelve a ser el error estándar de $\hat y$ en $x = \bar x$ . En general, el error estándar de $\hat y$ en cualquier $x$ es sólo el error estándar del intercepto de la regresión de $y$ en una traducción adecuada $x$ el error estándar de $\hat y$ en $x=0$ es, por supuesto, el error estándar del intercepto en la regresión original, no traducida.

Como podemos traducir $x$ En cierto sentido, no hay nada especial en $x=0$ y, por lo tanto, no hay nada especial en $\hat \beta_0$ . Pensando un poco, lo que voy a decir sirve para $\hat y$ en cualquier valor de $x$ , lo cual es útil si se busca conocer, por ejemplo, los intervalos de confianza para las respuestas medias de la línea de regresión. Sin embargo, hemos visto que hay es algo especial sobre $\hat y$ en $x=\bar x$ ya que es aquí donde los errores en la altura estimada de la línea de regresión -que por supuesto se estima en $\bar y$ - y los errores en la pendiente estimada de la línea de regresión no tienen nada que ver entre sí. Su intercepción estimada es $\hat \beta_0 = \bar y - \hat \beta_1 \bar x$ y los errores en su estimación deben provenir de la estimación de $\bar y$ o la estimación de $\hat \beta_1$ (ya que consideramos $x$ como no estocástico); ahora sabemos que estas dos fuentes de error no están correlacionadas, está claro, desde el punto de vista algebraico, por qué debería haber una correlación negativa entre la pendiente y el intercepto estimados (la sobreestimación de la pendiente tenderá a subestimar el intercepto, siempre que $\bar x < 0$ ) pero una correlación positiva entre el intercepto estimado y la respuesta media estimada $\hat y = \bar y$ en $x = \bar x$ . Pero también puede ver esas relaciones sin álgebra.

Imagine la línea de regresión estimada como una regla. Esa regla debe pasar por $(\bar x, \bar y)$ . Acabamos de ver que hay dos incertidumbres esencialmente no relacionadas en la ubicación de esta línea, que visualizo kinésicamente como la incertidumbre de "giro" y la incertidumbre de "deslizamiento paralelo". Antes de hacer girar la regla, sosténgala en $(\bar x, \bar y)$ como pivote, entonces dale un golpe de efecto relacionado con tu incertidumbre en la pendiente. La regla tendrá un buen bamboleo, más violento si estás muy inseguro sobre la pendiente (de hecho, una pendiente previamente positiva se convertirá muy posiblemente en negativa si tu incertidumbre es grande) pero observa que la altura de la línea de regresión en $x=\bar x$ no se ve afectado por este tipo de incertidumbre, y el efecto de la vibración es más notable cuanto más lejos de la media se mire.

Para "deslizar" la regla, sujétala con firmeza y desplázala hacia arriba y hacia abajo, teniendo cuidado de mantenerla paralela a su posición original, ¡no cambies la pendiente! La intensidad con la que se desplace hacia arriba y hacia abajo depende de la incertidumbre que se tenga sobre la altura de la línea de regresión cuando pasa por el punto medio; piense en cuál sería el error estándar del intercepto si $x$ había sido traducido para que el $y$ -pasa por el punto medio. Alternativamente, dado que la altura estimada de la línea de regresión aquí es simplemente $\bar y$ es también el error estándar de $\bar y$ . Obsérvese que este tipo de incertidumbre "deslizante" afecta a todos los puntos de la línea de regresión por igual, a diferencia de la "torsión".

Estas dos incertidumbres se aplican de forma independiente (bueno, sin correlación, pero si suponemos que los términos de error se distribuyen normalmente, deberían ser técnicamente independientes) por lo que las alturas $\hat y$ de todos los puntos de su línea de regresión se ven afectados por una incertidumbre "oscilante" que es cero en la media y empeora a partir de ella, y una incertidumbre "deslizante" que es la misma en todas partes. (¿Puede ver la relación con los intervalos de confianza de la regresión que prometí antes, en particular cómo su anchura es más estrecha en $\bar x$ ?)

Esto incluye la incertidumbre en $\hat y$ en $x=0$ que es esencialmente lo que queremos decir con el error estándar en $\hat \beta_0$ . Supongamos ahora que $\bar x$ está a la derecha de $x=0$ ; entonces, el cambio de la gráfica a una pendiente estimada más alta tiende a reducir nuestro intercepto estimado, como revelará un rápido boceto. Esta es la correlación negativa predicha por $\frac{-\bar{x}}{\sqrt{\MSD(x) + \bar{x}^2}}$ cuando $\bar x$ es positivo. Por el contrario, si $\bar x$ es la izquierda de $x=0$ verá que una mayor pendiente estimada tiende a aumentar nuestro intercepto estimado, en consonancia con la positivo correlación que su ecuación predice cuando $\bar x$ es negativo. Tenga en cuenta que si $\bar x$ está muy lejos de cero, la extrapolación de una línea de regresión de gradiente incierto hacia el $y$ -se vuelve cada vez más precario (la amplitud del "twang" empeora alejándose de la media). El error de "torsión" en el $ - \hat \beta_1 \bar x$ plazo superará masivamente el error de "deslizamiento" en el $\bar y$ por lo que el error en $\hat \beta_0$ está casi totalmente determinada por cualquier error en $\hat \beta_1$ . Como se puede comprobar fácilmente de forma algebraica, si tomamos $\bar x \to \pm \infty$ sin cambiar el MSD o la desviación estándar de los errores $s_u$ la correlación entre $\hat \beta_0$ y $\hat \beta_1$ tiende a $\mp 1$ .

Simulated slopes and intercepts

Para ilustrar esto (puede hacer clic con el botón derecho del ratón en la imagen y guardarla, o verla a tamaño completo en una nueva pestaña si dispone de esa opción) he elegido considerar muestreos repetidos de $y_i = 5 + 2x_i + u_i$ , donde $u_i \sim N(0, 10^2)$ son i.i.d., sobre un conjunto fijo de $x$ valores con $\bar x = 10$ Así que $\mathbb{E}(\bar y)=25$ . En esta configuración, existe una correlación negativa bastante fuerte entre la pendiente y el intercepto estimados, y una correlación positiva más débil entre $\bar y$ la respuesta media estimada en $x=\bar x$ y la intercepción estimada. La animación muestra varias muestras simuladas, con la línea de regresión de la muestra (dorada) dibujada sobre la línea de regresión verdadera (negra). La segunda fila muestra el aspecto que habría tenido la colección de líneas de regresión estimadas si sólo hubiera habido error en la línea estimada $\bar y$ y las pendientes coincidían con la pendiente real (error de "deslizamiento"); entonces, si sólo había error en las pendientes y $\bar y$ que coincidía con su valor poblacional (error de "redoble"); y, por último, cómo era realmente la colección de líneas estimadas, cuando se combinaban ambas fuentes de error. Se han codificado por colores por el tamaño del intercepto realmente estimado (no los interceptos mostrados en los dos primeros gráficos en los que se ha eliminado una de las fuentes de error) de azul para los interceptos bajos a rojo para los interceptos altos. Obsérvese que sólo por los colores podemos ver que las muestras con bajo $\bar y$ tienden a producir menores intercepciones estimadas, al igual que las muestras con alto pendientes estimadas. La siguiente fila muestra las distribuciones de muestreo simuladas (histograma) y teóricas (curva normal) de las estimaciones, y la última fila muestra gráficos de dispersión entre ellas. Obsérvese que no hay correlación entre $\bar y$ y la pendiente estimada, una correlación negativa entre el intercepto estimado y la pendiente, y una correlación positiva entre el intercepto y $\bar y$ .

¿Qué hace el MSD en el denominador de $\frac{-\bar{x}}{\sqrt{\MSD(x) + \bar{x}^2}}$ ? La ampliación de la gama de $x$ valores que se miden sobre es bien conocido que permite estimar la pendiente con mayor precisión, y la intuición es clara a partir de un croquis, pero no permite estimar $\bar y$ mejor. Le sugiero que visualice la toma de la DMS hasta cerca de cero (es decir, muestreando puntos sólo muy cerca de la media de $x$ ), de modo que su incertidumbre en la pendiente se vuelve masiva: piense en grandes giros, pero sin que cambie su incertidumbre de deslizamiento. Si su $y$ -El eje es cualquier distancia desde $\bar x$ (en otras palabras, si $\bar x \neq 0$ ) se encontrará con que la incertidumbre en su intercepción pasa a estar totalmente dominada por el error de torsión relacionado con la pendiente. En cambio, si aumenta la dispersión de su $x$ sin cambiar la media, mejorará enormemente la precisión de su estimación de la pendiente y sólo tendrá que dar un pequeño giro a su línea. La altura de su intercepción está ahora dominada por su incertidumbre de deslizamiento, que no tiene nada que ver con su pendiente estimada. Esto coincide con el hecho algebraico de que la correlación entre la pendiente estimada y el intercepto tiende a cero cuando $\MSD(x) \to \pm \infty$ y, cuando $\bar x \neq 0$ hacia $\pm 1$ (el signo es el opuesto al de $\bar x$ ) como $\MSD(x) \to 0$ .

La correlación de los estimadores de la pendiente y el intercepto fue una función de ambos $\bar x$ y el MSD (o RMSD) de $x$ ¿Cómo se ponderan sus contribuciones relativas? En realidad, lo único que importa es el relación de $\bar x$ a la RMSD de $x$ . Una intuición geométrica es que la RMSD nos da una especie de "unidad natural" para $x$ si reescalamos el $x$ -eje utilizando $w_i = x_i / \RMSD(x)$ entonces se trata de un tramo horizontal que sale de la intercepción estimada y $\bar y$ sin cambios, nos da una nueva $\RMSD(w)=1$ y multiplica la pendiente estimada por la RMSD de $x$ . La fórmula para la correlación entre los nuevos estimadores de la pendiente y el intercepto es sólo en términos de $\RMSD(w)$ que es uno, y $\bar w$ que es la relación $\frac{\bar x}{\RMSD(x)}$ . Como la estimación del intercepto no ha cambiado, y la estimación de la pendiente simplemente se ha multiplicado por una constante positiva, entonces la correlación entre ellos no ha cambiado: por lo tanto, la correlación entre el original La pendiente y el intercepto también deben depender únicamente de $\frac{\bar x}{\RMSD(x)}$ . Algebraicamente podemos ver esto dividiendo la parte superior e inferior de $\frac{-\bar x}{\sqrt{\MSD(x)+\bar{x}^2}}$ por $\RMSD(x)$ para obtener $\Corr\left(\hat \beta_0, \hat \beta_1 \right) = \frac{- (\bar x / \RMSD(x))}{\sqrt{1 + (\bar x / \RMSD(x))^2}}$ .

Para encontrar la correlación entre $\hat \beta_0$ y $\bar y$ Considera que $\DeclareMathOperator{\Cov}{Cov}\Cov(\hat \beta_0, \bar y)=\Cov(\bar y - \hat \beta_1 \bar x, \bar y)$ . Por la bilinealidad de $\Cov$ esto es $\Cov(\bar y, \bar y) - \bar x \Cov(\hat \beta_1, \bar y)$ . El primer término es $\operatorname{Var}(\bar y)=\frac{\sigma_u^2}{n}$ mientras que el segundo término que establecimos anteriormente es cero. De esto deducimos

$$\Corr(\hat \beta_0, \bar y)=\frac{1}{\sqrt{1 + (\bar x/\RMSD(x))^2}}$$

Así que esta correlación también depende sólo de la relación $\frac{\bar x}{\RMSD(x)}$ . Obsérvese que los cuadrados de $\Corr(\hat \beta_0, \hat \beta_1)$ y $\Corr(\hat \beta_0, \bar y)$ suman uno: lo esperamos ya que todo variación del muestreo (para un $x$ ) en $\hat \beta_0$ se debe a la variación de $\hat \beta_1$ o a la variación de $\bar y$ y estas fuentes de variación no están correlacionadas entre sí. A continuación se muestra un gráfico de las correlaciones frente a la relación $\frac{\bar x}{\RMSD(x)}$ .

Correlation of intercept and slope, and intercept and mean y, against ratio of mean x to RMSD

El gráfico muestra claramente cómo cuando $\bar x$ es alta en relación con el RMSD los errores en la estimación del intercepto se deben en gran medida a los errores en la estimación de la pendiente y ambos están estrechamente correlacionados, mientras que cuando $\bar x$ es baja en relación con el RMSD es el error en la estimación de $\bar y$ que predomina, y la relación entre el intercepto y la pendiente es más débil. Obsérvese que la correlación del intercepto con la pendiente es una función impar de la relación $\frac{\bar x}{\RMSD(x)}$ por lo que su signo depende del signo de $\bar x$ y es cero si $\bar x=0$ mientras que la correlación del intercepto con $\bar y$ es siempre positivo y es una función par de la relación, es decir, no importa el lado de la $y$ -eje que $\bar x$ es. Las correlaciones son de igual magnitud si $\bar x$ está a un RMSD del $y$ -eje, cuando $\Corr(\hat \beta_0, \bar y)=\frac{1}{\sqrt{2}} \approx 0.707$ y $\Corr(\hat \beta_0, \hat \beta_1)=\pm \frac{1}{\sqrt{2}} \approx \pm 0.707$ donde el signo es opuesto al de $\bar x$ . En el ejemplo de la simulación anterior, $\bar x=10$ y $\RMSD(x) \approx 5.16$ por lo que la media era de $1.93$ RMSDs del $y$ -En esta relación, la correlación entre el intercepto y la pendiente es más fuerte, pero la correlación entre el intercepto y el $\bar y$ no es despreciable.

Como apunte, me gusta pensar en la fórmula del error estándar del intercepto,

$$\operatorname{s.e.}(\hat \beta_0^{OLS}) = \sqrt{s_u^2 \left( \frac{1}{n} + \frac{{\bar x}^2 }{n \MSD(x)} \right) }$$

como $\sqrt{\text{sliding error} + \text{twanging error}}$ y lo mismo para la fórmula del error estándar de $\hat y$ en $x = x_0$ (utilizado para los intervalos de confianza para la respuesta media, y del que el intercepto es sólo un caso especial como he explicado antes a través de un argumento de traducción),

$$\operatorname{s.e.}(\hat y) = \sqrt{s_u^2 \left( \frac{1}{n} + \frac{(x_0 - \bar x)^2}{n \MSD(x)} \right) }$$

Código R para los gráficos

require(graphics)
require(grDevices)
require(animation

#This saves a GIF so you may want to change your working directory
#setwd("~/YOURDIRECTORY")
#animation package requires ImageMagick or GraphicsMagick on computer
#See: http://www.inside-r.org/packages/cran/animation/docs/im.convert
#You might only want to run up to the "STATIC PLOTS" section
#The static plot does not save a file, so need to change directory.

#Change as desired
simulations <- 100 #how many samples to draw and regress on
xvalues <- c(2,4,6,8,10,12,14,16,18) #used in all regressions
su <- 10 #standard deviation of error term
beta0 <- 5 #true intercept
beta1 <- 2 #true slope
plotAlpha <- 1/5 #transparency setting for charts
interceptPalette <- colorRampPalette(c(rgb(0,0,1,plotAlpha),
            rgb(1,0,0,plotAlpha)), alpha = TRUE)(100) #intercept color range
animationFrames <- 20 #how many samples to include in animation

#Consequences of previous choices
n <- length(xvalues) #sample size
meanX <- mean(xvalues) #same for all regressions
msdX <- sum((xvalues - meanX)^2)/n #Mean Square Deviation
minX <- min(xvalues)
maxX <- max(xvalues)
animationFrames <- min(simulations, animationFrames)

#Theoretical properties of estimators
expectedMeanY <- beta0 + beta1 * meanX
sdMeanY <- su / sqrt(n) #standard deviation of mean of Y (i.e. Y hat at mean x)
sdSlope <- sqrt(su^2 / (n * msdX))
sdIntercept <- sqrt(su^2 * (1/n + meanX^2 / (n * msdX)))

data.df <- data.frame(regression = rep(1:simulations, each=n),
                      x = rep(xvalues, times = simulations))

data.df$y <- beta0 + beta1*data.df$x + rnorm(n*simulations, mean = 0, sd = su) 

regressionOutput <- function(i){ #i is the index of the regression simulation
  i.df <- data.df[data.df$regression == i,]
  i.lm <- lm(y ~ x, i.df)
  return(c(i, mean(i.df$y), coef(summary(i.lm))["x", "Estimate"],
          coef(summary(i.lm))["(Intercept)", "Estimate"]))
}

estimates.df <- as.data.frame(t(sapply(1:simulations, regressionOutput)))
colnames(estimates.df) <- c("Regression", "MeanY", "Slope", "Intercept")

perc.rank <- function(x) ceiling(100*rank(x)/length(x))
rank.text <- function(x) ifelse(x < 50, paste("bottom", paste0(x, "%")), 
                                paste("top", paste0(101 - x, "%")))
estimates.df$percMeanY <- perc.rank(estimates.df$MeanY)
estimates.df$percSlope <- perc.rank(estimates.df$Slope)
estimates.df$percIntercept <- perc.rank(estimates.df$Intercept)
estimates.df$percTextMeanY <- paste("Mean Y", 
                                    rank.text(estimates.df$percMeanY))
estimates.df$percTextSlope <- paste("Slope",
                                    rank.text(estimates.df$percSlope))
estimates.df$percTextIntercept <- paste("Intercept",
                                    rank.text(estimates.df$percIntercept))

#data frame of extreme points to size plot axes correctly
extremes.df <- data.frame(x = c(min(minX,0), max(maxX,0)),
              y = c(min(beta0, min(data.df$y)), max(beta0, max(data.df$y))))

#STATIC PLOTS ONLY

par(mfrow=c(3,3))

#first draw empty plot to reasonable plot size
with(extremes.df, plot(x,y, type="n", main = "Estimated Mean Y"))
invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                 estimates.df$Intercept, beta1, 
                 interceptPalette[estimates.df$percIntercept]))

with(extremes.df, plot(x,y, type="n", main = "Estimated Slope"))
invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                 expectedMeanY - estimates.df$Slope * meanX, estimates.df$Slope, 
                 interceptPalette[estimates.df$percIntercept]))

with(extremes.df, plot(x,y, type="n", main = "Estimated Intercept"))
invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                 estimates.df$Intercept, estimates.df$Slope, 
                 interceptPalette[estimates.df$percIntercept]))

with(estimates.df, hist(MeanY, freq=FALSE, main = "Histogram of Mean Y",
                        ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdMeanY))))
curve(dnorm(x, mean=expectedMeanY, sd=sdMeanY), lwd=2, add=TRUE)

with(estimates.df, hist(Slope, freq=FALSE, 
                        ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdSlope))))
curve(dnorm(x, mean=beta1, sd=sdSlope), lwd=2, add=TRUE)

with(estimates.df, hist(Intercept, freq=FALSE, 
                        ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdIntercept))))
curve(dnorm(x, mean=beta0, sd=sdIntercept), lwd=2, add=TRUE)

with(estimates.df, plot(MeanY, Slope, pch = 16,  col = rgb(0,0,0,plotAlpha), 
                        main = "Scatter of Slope vs Mean Y"))

with(estimates.df, plot(Slope, Intercept, pch = 16, col = rgb(0,0,0,plotAlpha),
                        main = "Scatter of Intercept vs Slope"))

with(estimates.df, plot(Intercept, MeanY, pch = 16, col = rgb(0,0,0,plotAlpha),
                        main = "Scatter of Mean Y vs Intercept"))

#ANIMATED PLOTS

makeplot <- function(){for (i in 1:animationFrames) {

  par(mfrow=c(4,3))

  iMeanY <- estimates.df$MeanY[i]
  iSlope <- estimates.df$Slope[i]
  iIntercept <- estimates.df$Intercept[i]

  with(extremes.df, plot(x,y, type="n", main = paste("Simulated dataset", i)))
  with(data.df[data.df$regression==i,], points(x,y))
  abline(beta0, beta1, lwd = 2)
  abline(iIntercept, iSlope, lwd = 2, col="gold")

  plot.new()
  title(main = "Parameter Estimates")
  text(x=0.5, y=c(0.9, 0.5, 0.1), labels = c(
    paste("Mean Y =", round(iMeanY, digits = 2), "True =", expectedMeanY),
    paste("Slope =", round(iSlope, digits = 2), "True =", beta1),
    paste("Intercept =", round(iIntercept, digits = 2), "True =", beta0)))

  plot.new()
  title(main = "Percentile Ranks")
  with(estimates.df, text(x=0.5, y=c(0.9, 0.5, 0.1),
                          labels = c(percTextMeanY[i], percTextSlope[i],
                                     percTextIntercept[i])))

  #first draw empty plot to reasonable plot size
  with(extremes.df, plot(x,y, type="n", main = "Estimated Mean Y"))
  invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                   estimates.df$Intercept, beta1, 
                   interceptPalette[estimates.df$percIntercept]))
  abline(iIntercept, beta1, lwd = 2, col="gold")

  with(extremes.df, plot(x,y, type="n", main = "Estimated Slope"))
  invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                expectedMeanY - estimates.df$Slope * meanX, estimates.df$Slope, 
                interceptPalette[estimates.df$percIntercept]))
  abline(expectedMeanY - iSlope * meanX, iSlope,
         lwd = 2, col="gold")

  with(extremes.df, plot(x,y, type="n", main = "Estimated Intercept"))
  invisible(mapply(function(a,b,c) { abline(a, b, col=c) }, 
                   estimates.df$Intercept, estimates.df$Slope, 
                   interceptPalette[estimates.df$percIntercept]))
  abline(iIntercept, iSlope, lwd = 2, col="gold")

  with(estimates.df, hist(MeanY, freq=FALSE, main = "Histogram of Mean Y",
                          ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdMeanY))))
  curve(dnorm(x, mean=expectedMeanY, sd=sdMeanY), lwd=2, add=TRUE)
  lines(x=c(iMeanY, iMeanY),
        y=c(0, dnorm(iMeanY, mean=expectedMeanY, sd=sdMeanY)),
        lwd = 2, col = "gold")

  with(estimates.df, hist(Slope, freq=FALSE, 
                          ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdSlope))))
  curve(dnorm(x, mean=beta1, sd=sdSlope), lwd=2, add=TRUE)
  lines(x=c(iSlope, iSlope), y=c(0, dnorm(iSlope, mean=beta1, sd=sdSlope)),
        lwd = 2, col = "gold")

  with(estimates.df, hist(Intercept, freq=FALSE, 
                          ylim=c(0, 1.3*dnorm(0, mean=0, sd=sdIntercept))))
  curve(dnorm(x, mean=beta0, sd=sdIntercept), lwd=2, add=TRUE)
  lines(x=c(iIntercept, iIntercept),
        y=c(0, dnorm(iIntercept, mean=beta0, sd=sdIntercept)),
        lwd = 2, col = "gold")

  with(estimates.df, plot(MeanY, Slope, pch = 16,  col = rgb(0,0,0,plotAlpha), 
                          main = "Scatter of Slope vs Mean Y"))
  points(x = iMeanY, y = iSlope, pch = 16, col = "gold")

  with(estimates.df, plot(Slope, Intercept, pch = 16, col = rgb(0,0,0,plotAlpha),
                          main = "Scatter of Intercept vs Slope"))
  points(x = iSlope, y = iIntercept, pch = 16, col = "gold")

  with(estimates.df, plot(Intercept, MeanY, pch = 16, col = rgb(0,0,0,plotAlpha),
                          main = "Scatter of Mean Y vs Intercept"))
  points(x = iIntercept, y = iMeanY, pch = 16, col = "gold")

}}

saveGIF(makeplot(), interval = 4, ani.width = 500, ani.height = 600)

Para el gráfico de correlación frente a la relación de $\bar x$ a RMSD:

require(ggplot2)

numberOfPoints <- 200
data.df  <- data.frame(
  ratio = rep(seq(from=-10, to=10, length=numberOfPoints), times=2),
  between = rep(c("Slope", "MeanY"), each=numberOfPoints))
data.df$correlation <- with(data.df, ifelse(between=="Slope",
  -ratio/sqrt(1+ratio^2),
  1/sqrt(1+ratio^2)))

ggplot(data.df, aes(x=ratio, y=correlation, group=factor(between),
                    colour=factor(between))) +
  theme_bw() + 
  geom_line(size=1.5) +
  scale_colour_brewer(name="Correlation between", palette="Set1",
                      labels=list(expression(hat(beta[0])*" and "*bar(y)),
                              expression(hat(beta[0])*" and "*hat(beta[1])))) +
  theme(legend.key = element_blank()) +
  ggtitle(expression("Correlation of intercept estimates with slope and "*bar(y))) +
  xlab(expression("Ratio of "*bar(X)/"RMSD(X)")) +
  ylab(expression(paste("Correlation")))

19voto

Christoph Hanck Puntos 4143

Permítanme intentarlo de la siguiente manera (realmente no estoy seguro de que sea una intuición útil):

Basándome en mi comentario anterior, la correlación será aproximadamente $$-\frac{E(X)}{\sqrt{E(X^2)}}$$ Así, si $E(X)>0$ en lugar de $E(X)=0$ la mayoría de los datos se agruparán a la derecha de cero. Por lo tanto, si el coeficiente de la pendiente es mayor, la fórmula de correlación afirma que el intercepto debe ser menor, lo que tiene cierto sentido.

Estoy pensando en algo así:

En la muestra azul, la estimación de la pendiente es más plana, lo que significa que la estimación del intercepto puede ser mayor. La pendiente de la muestra dorada es algo mayor, por lo que el intercepto puede ser algo menor para compensarlo.

enter image description here

Por otro lado, si $E(X)=0$ podemos tener cualquier pendiente sin ninguna restricción en el intercepto.

El denominador de la fórmula también puede interpretarse así: si, para una media dada, la variabilidad medida por $E(X^2)$ aumenta, los datos se desparraman por el $x$ -para que efectivamente "parezca" más media cero de nuevo, aflojando las restricciones del intercepto para una media dada de $X$ .

Aquí está el código, que espero que explique completamente la figura:

n <- 30
x_1 <- sort(runif(n,2,3))
beta <- 2
y_1 <- x_1*beta + rnorm(n) # the golden sample

x_2 <- sort(runif(n,2,3)) 
beta <- 2
y_2 <- x_2*beta + rnorm(n) # the blue sample

xax <- seq(-1,3,by=.001)
plot(x_1,y_1,xlim=c(-1,3),ylim=c(-4,7),pch=19,col="gold",ylab="y",xlab="x")
abline(lm(y_1~x_1),col="gold",lwd=2)
abline(v=0,lty=2)
lines(xax,beta*xax) # the "true" regression line
abline(lm(y_2~x_2),col="lightblue",lwd=2)
points(x_2,y_2,pch=19,col="lightblue")

i-Ciencias.com

I-Ciencias es una comunidad de estudiantes y amantes de la ciencia en la que puedes resolver tus problemas y dudas.
Puedes consultar las preguntas de otros usuarios, hacer tus propias preguntas o resolver las de los demás.

Powered by:

X