截距和斜率的OLS估计量之间的相关性

在简单的回归模型中

y = β_{0} + β_{1} x + ε,

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

OLS估计量和是相关的。 $\hat{\beta}_0^{OLS}$ $\hat{\beta}_1^{OLS}$

两个估计量之间的相关性公式为（如果我正确推导得出的话）：

Corr ({\hat{β}}_{0}^{O L S}, {\hat{β}}_{1}^{O L S}) = \frac{- \sum_{i = 1}^{n} x_{i}}{\sqrt{n} \sqrt{\sum_{i = 1}^{n} x_{i}^{2}}} .

$\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} }.$

问题：

关于相关性的直观解释是什么？
相关性的存在是否有任何重要含义？

编辑了该帖子，并删除了相关性随样本大小消失的断言。（感谢@whuber和@ChristophHanck。）

regression least-squares estimators

— 理查德·哈迪
source

该公式是正确的，但是请您说明一下所使用的渐近线？毕竟，在许多情况下，相关性并不会消失-它趋于稳定。考虑例如一个实验，其中是二进制的，并且假设通过在和之间交替来收集数据。那么，无论变大，其相关性总是接近。

x_{i}

$x_i$

x_{i}

$x_i$

1

$1$

0

$0$

\sum x_{i} = \sum x_{i}^{2} \approx n / 2

$\sum x_i = \sum x_i^2 \approx n/2$

\sqrt{2} / 2 \neq 0

$\sqrt{2}/2 \ne 0$

n

$n$

— ub

我要说的是，只有在时才消失：写它趋于。

E (X) = 0

$E(X)=0$

Corr ({\hat{β}}_{0}^{O L S}, {\hat{β}}_{1}^{O L S}) = \frac{- \frac{1}{N} \sum_{i = 1}^{N} x_{i}}{\sqrt{\frac{N \sum_{i = 1}^{N} x_{i}^{2}}{N^{2}}}} = \frac{- \frac{1}{N} \sum_{i = 1}^{N} x_{i}}{\sqrt{\frac{\sum_{i = 1}^{N} x_{i}^{2}}{N}}},

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

- E (X) / \sqrt{E (X^{2})}

$-E(X)/\sqrt{E(X^2)}$

— Christoph Hanck

确实，当我随着增加而推导相关行为时，我错过了一个。所以胡布和克里斯托弗·汉克是正确的。我仍然对一个直观的解释感兴趣，即为什么相关性首先为非零以及任何有用的含义。（我并不是说相关性应该直观地为零，我只是这里没有直觉。）

n

$n$

n

$n$

— Richard Hardy 2015年

您的公式巧妙地显示出，例如，对于均值回归变量，与截距的相关性消失。

x

$x$

— Michael M

相关：为什么截距的标准误差会进一步使从0开始增加？

\bar{x}

$\bar x$

— gung-恢复莫妮卡

让我按以下方式尝试（真的不确定这是否有用）：

根据我的上述评论，相关性大致为因此，如果而不是，大多数数据将聚类到零的右边。因此，如果斜率系数变大，则相关公式会断言截距需要变小-这是有道理的。

- \frac{E (X)}{\sqrt{E (X^{2})}}

$-\frac{E(X)}{\sqrt{E(X^2)}}$

E (X) > 0

$E(X)>0$

E (X) = 0

$E(X)=0$

我在想这样的事情：

在蓝色样本中，斜率估计值更平坦，这意味着截距估计值可以更大。黄金样本的斜率较大，因此截距可以较小以弥补这一点。

另一方面，如果，我们可以具有任意斜率，而对截距没有任何约束。 $E(X)=0$

公式的分母也可以按照以下方式解释：如果对于给定的平均值，由测得的变异性增加，则数据会在轴上被抹去，因此它实际上“看起来像“再一次将均值设为零，对于给定的均值放宽对截距的限制。 $E(X^2)$ $x$ $X$

这是代码，我希望可以完全解释该图：

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")

— 克里斯多夫·汉克
source

对于实际意义，请考虑开发和使用实验室仪器的校准曲线。为了进行校准，使用仪器测试已知值，并测量仪器的值，然后进行线性回归。然后将未知样品应用于仪器，并使用新的值基于线性回归校准来预测未知。未知数的估计值的误差分析将涉及回归斜率和截距的估计值之间的相关性。

x

$x$

y

$y$

y

$y$

x

$x$

x

$x$

— EdM

您可能想遵循Dougherty的《计量经济学概论》，也许现在考虑是一个非随机变量，并将的均方差定义为。请注意，MSD以单位的平方测量（例如，如果在则MSD在），而均方根偏差处于原始比例。这产生 $x$ $x$ $\DeclareMathOperator{\MSD}{MSD}\MSD(x) = \frac{1}{n} \sum_{i=1}^n (x_i - \bar{x})^2$ $x$ $x$ $\text{cm}$ $\text{cm}^2$ $\DeclareMathOperator{\RMSD}{RMSD}\RMSD(x)=\sqrt{\MSD(x)}$

Corr ({\hat{β}}_{0}^{O L S}, {\hat{β}}_{1}^{O L S}) = \frac{- \bar{x}}{\sqrt{MSD (x) + {\bar{x}}^{2}}}

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

这应该可以帮助您了解相关由两个影响平均的（特别是如果你的斜率和截距估计之间的相关性被删除变量居中）并且还通过它的传播。（这种分解也可能使渐近性更加明显！） $x$ $x$

我将重申此结果的重要性：如果均值不为零，我们可以通过减去对其进行变换，使其现在居中。如果我们在上拟合的回归线，则斜率和截距估计值是不相关的-一个中的低估或高估不会导致另一个中的低估或高估。但是，这条回归线只是在回归线上的转换！行上的截距的标准误差只是当翻译变量时不确定性的度量。 $x$ $\bar{x}$ $y$ $x - \bar{x}$ $y$ $x$ $y$ $x - \bar{x}$ $\hat y$ $x - \bar x = 0$ ; 当该行转换回其原始位置时，它恢复为处的的标准误差。更普遍地说，在任何值处的标准误差只是在适当转换的上回归的截距的标准误差；的标准误差在，当然在原始的，未翻译的回归截距的标准误差的。 $\hat y$ $x = \bar x$ $\hat y$ $x$ $y$ $x$ $\hat y$ $x=0$

因为我们可以翻译，所以从某种意义上讲，没有什么特别的，因此也没有什么特别的。稍加思考，我要说的对于在任何值下都适用，如果您想了解例如回归线的均值响应的置信区间，这将很有用。然而，我们已经看到，是什么特别之处在，因为它是在这里，在回归线的估计高度误差-这当然是估计 $x$ $x=0$ $\hat \beta_0$ $\hat y$ $x$ $\hat y$ $x=\bar x$ $\bar y$ —和回归线的估计斜率中的误差彼此无关。您估计的截距是，其估计错误必须源自的估计或的估计（因为我们将视为非-随机）; 现在我们知道这两个误差源是不相关的，从代数上可以清楚地看出，为什么估计斜率和截距之间应该存在负相关（只要，高估斜率就会低估截距），但是估计值之间却存在正相关截距和估计的平均响应在 $\hat \beta_0 = \bar y - \hat \beta_1 \bar x$ $\bar y$ $\hat \beta_1$ $x$ $\bar x < 0$ $\hat y = \bar y$ $x = \bar x$ 。但是也可以不用代数看到这样的关系。

想象一下估计的回归线作为标尺。该标尺必须通过。我们刚刚看到，在这条线的位置上存在两个本质上无关的不确定性，我将其从运动学角度想象为“扭曲”不确定性和“平行滑动”不确定性。在拉动标尺之前，先将其握在作为枢轴，然后根据您在坡度中的不确定性给它一个丰满的twang。标尺会剧烈摆动，因此如果您不确定斜率（实际上，如果不确定性很大，以前的正斜率很可能会变为负数），但是请注意，回归线在处的高度 $(\bar x, \bar y)$ $(\bar x, \bar y)$ $x=\bar x$ 这种不确定性不会改变Twang的影响，而且距离您所看的均值越远，twang的影响就越明显。

要“滑动”标尺，请牢牢握住并上下移动标尺，并注意使其与原始位置保持平行-请勿更改坡度！向上和向下移动的强烈程度取决于您对回归线穿过平均点时高度的不确定性。想一想，如果已平移，以使轴穿过均值，则截距的标准误差是多少。或者，由于此处回归线的估计高度仅为，因此它也是的标准误差。请注意，这种“滑动”不确定性以同等方式影响回归线上的所有点，这与“ twang”不同。 $x$ $y$ $\bar y$ $\bar y$

这两个不确定性是独立适用的（很好，没有相关性，但是如果我们假设正态分布误差项，则它们在技术上应该是独立的），因此回归线上所有点的高度受“不确定”不确定性的影响，该不确定性在0为平均数和远离它的平均值会变得更糟，并且“滑动”不确定性在各地都相同。（您是否可以看到与我先前承诺的回归置信区间的关系，特别是它们的宽度在处最窄的情况？） $\hat y$ $\bar x$

这包括在处中的不确定性，这基本上就是我们在的标准误差的。现在假设在的右边；然后将图形扭曲到较高的估计斜率往往会减少我们的估计截距，因为快速草图会显示出来。当为正数时，这是预测的负相关。相反，如果是的左侧，您会看到较高的估计斜率往往会增加我们的估计截距，与正数一致 $\hat y$ $x=0$ $\hat \beta_0$ $\bar x$ $x=0$ $\frac{-\bar{x}}{\sqrt{\MSD(x) + \bar{x}^2}}$ $\bar x$ $\bar x$ $x=0$ 方程预测为负时的相关性。请注意，如果与零之间有一段很长的距离，则不确定梯度的回归线朝轴的外推变得越来越不稳定（“ twang”的幅度远离平均值而变差）。项中的“抖动”错误将大大超过项中的“滑动”错误，因此的错误几乎完全由任何错误确定。您可以轻松地通过代数验证，如果我们在不更改MSD或误差的标准偏差的情况下，将 $\bar x$ $\bar x$ $y$ $- \hat \beta_1 \bar x$ $\bar y$ $\hat \beta_0$ $\hat \beta_1$ $\bar x \to \pm \infty$ $s_u$ ，和之间的相关性趋于。 $\hat \beta_0$ $\hat \beta_1$ $\mp 1$

为了说明这一点（您可能需要右键单击图像并保存它，或者如果可以使用该选项，则可以在新选项卡中以全尺寸查看它）我选择考虑重复采样，其中是iid，位于的个固定值上，因此。在此设置中，估计的斜率和截距之间存在相当强的负相关性，而（在处的估计平均响应）之间的正相关性较弱。 $y_i = 5 + 2x_i + u_i$ $u_i \sim N(0, 10^2)$ $x$ $\bar x = 10$ $\mathbb{E}(\bar y)=25$ $\bar y$ $x=\bar x$ ，并估计截距。动画显示了几个模拟的样本，在真实（黑色）回归线上绘制了样本（金）回归线。第二行显示如果仅在估计存在误差并且斜率与真实斜率匹配（“滑动”误差），则估计回归线的集合将是什么样子；然后，如果仅在坡度中存在错误，并且匹配其总体值（“扭曲”错误）；最后，当将两个误差源组合在一起时，估计行的集合实际上看起来是什么样的。这些已经通过实际估计的截距的大小进行了颜色编码 $\bar y$ $\bar y$ （不是前两个图形所示的截距，其中一个误差源已被消除）从蓝色（低截距）到红色（高截距）。请注意，仅从颜色中我们可以看到，具有低样本倾向于产生较低的估计截距，而具有高估计斜率的样本也是如此。下一行显示了估算值的模拟（直方图）和理论（正态曲线）采样分布，最后一行显示了它们之间的散点图。观察与估计斜率之间没有相关性，估计截距和斜率之间呈负相关，截距与之间呈正相关。 $\bar y$ $\bar y$ $\bar y$

MSD在分母中做什么？众所周知，散布您测量的值的范围可以使您更精确地估计斜率，并且从直觉上可以很直观地看出来，但这并不能使您更好地估计。我建议您以可视化方式将MSD逼近零（即，采样点仅非常接近的均值），以使您在斜率中的不确定性变得很大：想想很大的twangs，但您的滑动不确定性没有变化。如果轴与距离是任何距离（换句话说，如果 $\frac{-\bar{x}}{\sqrt{\MSD(x) + \bar{x}^2}}$ $x$ $\bar y$ $x$ $y$ $\bar x$ $\bar x \neq 0$ ），您会发现截距中的不确定性完全由与坡度相关的扭曲误差所决定。相反，如果在不改变平均值的情况下增加量度的分布，则将大大提高斜率估计的精度，并且只需将最柔和的twangs移到线路上即可。截距的高度现在由滑动不确定性决定，这与您估计的斜率无关。这符合代数事实，即当时，估计坡度和截距之间的相关性趋于零，而当，趋向于（符号与的符号）为 $x$ $\MSD(x) \to \pm \infty$ $\bar x \neq 0$ $\pm 1$ $\bar x$ $\MSD(x) \to 0$ 。

斜率和截距估计量的相关性是和的MSD（或RMSD）的，因此它们的相对贡献如何加权？其实，所有的事情是比向的RMSD。几何直觉是，RMSD为提供了一种“自然单位” 。如果我们使用重新缩放轴，则这是一个水平拉伸，使估计的截距和保持不变，为我们提供了一个新的，然后将估计值乘以的RMSD斜率 $\bar x$ $x$ $\bar x$ $x$ $x$ $x$ $w_i = x_i / \RMSD(x)$ $\bar y$ $\RMSD(w)=1$ $x$ 。新的斜率和截距估计量之间的相关性公式仅（为1）和（其为比率。由于截距估计值不变，并且斜率估计值仅乘以一个正常数，因此它们之间的相关性没有改变：因此，原始斜率和截距之间的相关性也必须仅取决于。代数上，我们可以通过将除以来获得此结果 $\RMSD(w)$ $\bar w$ $\frac{\bar x}{\RMSD(x)}$ $\frac{\bar x}{\RMSD(x)}$ $\frac{-\bar x}{\sqrt{\MSD(x)+\bar{x}^2}}$ $\RMSD(x)$ $\Corr\left(\hat \beta_0, \hat \beta_1 \right) = \frac{- (\bar x / \RMSD(x))}{\sqrt{1 + (\bar x / \RMSD(x))^2}}$ 。

要找到和之间的相关性，请考虑。根据双线性，这是。第一项是而我们先前建立的第二项是零。由此我们推断 $\hat \beta_0$ $\bar y$ $\DeclareMathOperator{\Cov}{Cov}\Cov(\hat \beta_0, \bar y)=\Cov(\bar y - \hat \beta_1 \bar x, \bar y)$ $\Cov$ $\Cov(\bar y, \bar y) - \bar x \Cov(\hat \beta_1, \bar y)$ $\operatorname{Var}(\bar y)=\frac{\sigma_u^2}{n}$

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

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

因此，此关联也仅取决于比率。请注意，和平方之和为1：由于所有采样变化（对于固定我们都希望如此）是由于变化或由于的变化，并且这些变化的来源彼此不相关。这是与比率。 $\frac{\bar x}{\RMSD(x)}$ $\Corr(\hat \beta_0, \hat \beta_1)$ $\Corr(\hat \beta_0, \bar y)$ $x$ $\hat \beta_0$ $\hat \beta_1$ $\bar y$ $\frac{\bar x}{\RMSD(x)}$

该图清楚地显示了当相对于RMSD高时，截距估计值中的误差主要是由于斜率估计值中的误差引起的，并且两者密切相关，而当相对于RMSD低时，则截距估计中的误差非常大。是估计中的误差（占主导），并且截距和斜率之间的关系较弱。请注意，截距与斜率的相关性是比率的奇函数，因此其符号取决于的符号，如果则为零，而截距与的相关性 $\bar x$ $\bar x$ $\bar y$ $\frac{\bar x}{\RMSD(x)}$ $\bar x$ $\bar x=0$ $\bar y$ 总是正数，并且是比率的偶数函数，即在轴的哪一侧都无关紧要。如果与轴相距一个RMSD ，则当且，其中符号与相对。在上面的模拟示例中，和因此平均值相对于约为 RMSD $y$ $\bar x$ $\bar x$ $y$ $\Corr(\hat \beta_0, \bar y)=\frac{1}{\sqrt{2}} \approx 0.707$ $\Corr(\hat \beta_0, \hat \beta_1)=\pm \frac{1}{\sqrt{2}} \approx \pm 0.707$ $\bar x$ $\bar x=10$ $\RMSD(x) \approx 5.16$ $1.93$ $y$ -轴; 在此比率下，截距与斜率之间的相关性较强，但截距与之间的相关性仍不可忽略。 $\bar y$

顺便说一句，我喜欢考虑截距标准误差的公式，

s . e . ({\hat{β}}_{0}^{O L S}) = \sqrt{s_{u}^{2} (\frac{1}{n} + \frac{{\bar{x}}^{2}}{n MSD (x)})}

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

为，同上表示处的标准误差的公式（用于均值响应的置信区间，其中截取只是一种特殊情况，正如我之前通过翻译参数所解释的那样）， $\sqrt{\text{sliding error} + \text{twanging error}}$ $\hat y$ $x = x_0$

s . e . (\hat{y}) = \sqrt{s_{u}^{2} (\frac{1}{n} + \frac{(x_{0} - \bar{x})^{2}}{n MSD (x)})}

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

情节的R代码

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)

对于与RMSD 的关系与比率的关系图： $\bar x$

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")))

— 蠹虫
source

“ twang”和“ slide”是我的用语。这是我自己的视觉直觉，尽管在这里的基本思想都是标准材料，但我从未在任何教科书中见过。天哪知道是否有比“ twang”和“ slide”更多的技术名称！我从记忆中得出的答案是基于对一个相关问题的答案，而我从来没有回过头来完成和发布。我将添加更多具有指导意义的图形（如果我可以在旧计算机上跟踪R代码，或者找到复制的时间）。

— Silverfish

干什么！非常感谢你！现在，我的理解必定会好得多。

— 理查德·哈迪

@RichardHardy我放入了一个模拟动画，这应该使事情更加清晰。

— 银鱼