Needs["MultivariateStatistics`"]

SD- und Regressionsgeraden

Goal

Erklaeren und demonstrieren was der Unterschied zwischen einer standard deviation (SD) und Regressionsgeraden ist

data

Use the classical data of Galton: pairs of "height of a father" (GaltonX) and "height of a father's son" (GaltonY)

GaltonDat=Import["http://stat-www.berkeley.edu/users/juliab/141C/pearson.dat","Table"];
GaltonX=GaltonDat[[All,1]];
GaltonY=GaltonDat[[All,2]];

Number of measurement pairs

Length[GaltonX]

Scatterplot

GaltonScatter=ListPlot[
GaltonDat
,BaseStyle->{FontFamily->"Times",FontSize->14}
,FrameLabel->{"Fathers' Height [in.]","Sons' Height [in.]"}
,Joined->False
,PlotRange->{{55,80},{55,80}}
,AspectRatio->Automatic
,Frame->True,FrameTicks->{LinTicks[55,80,2,2],LinTicks[55,80,2,2],LinTicks[55,80,2,2,ShowTickLabels->False],LinTicks[55,80,2,2,ShowTickLabels->False]}]

some descriptive Statistics

{GalX,GalY}=Transpose[GaltonDat];
{{minx,maxx},{miny,maxy}}=Map[{Min[#],Max[#]}&,{GalX,GalY}]

SDevX=StandardDeviation[GaltonX]
SDevY=StandardDeviation[GaltonY]
MY=Mean[GaltonY]
MX=Mean[GaltonX]

Fit  regression

some variations ... all result in the same thing

lmTr=LinearModelFit[Transpose@{GaltonX,GaltonY},{1,x},x];
lmTr["BestFit"]
LinRegr=Fit[GaltonDat,{1,x},x]
lm=LinearModelFit[GaltonDat,{1,x},x]
lm["BestFit"]

q=EllipsoidQuartiles[GaltonDat];

"LinearModelFit" offers some more options :

lm[{"RSquared","ANOVATable"}]

some remarks

- in this data-set, SDevX ∼ SDevY.This is why the red line goes almost through the origin (0,0)
- there is a fair bit of scatter, correlation is only medium

VectorQ[GaltonX]

some bivariate statistics

r2=Correlation[GaltonX,GaltonY]

CovXY=Covariance[GaltonX,GaltonY]
CovYX=Covariance[GaltonY,GaltonX]

r=(CovXY/(SDevX*SDevY))

constructing the regression line manually

slope1=r2*SDevY/SDevX
intercept1=MY-(slope1*MX)
regrLine=intercept1+slope1*x

constructing the SDLine manually

slope2=Sign[r2]*SDevY/SDevX
intercept2=(MY-(slope2*MX))
SDLine=slope2*x+intercept2

Discussion of plot

regrLine is the same as LinRegr (green and blue)
SD line is red

OneSDrightofMean=MX+SDevX

LinesCPH=Plot[{regrLine,SDLine,LinRegr},{x,0,80}
,AspectRatio->1
,PlotRange->{{0,80},{0,80}}
,PlotStyle->{
{RGBColor[0,1,0],Thickness[0.01]} (*green*)
,{RGBColor[1,0,0],Thickness[0.01]} (*red*)
,{RGBColor[0,0,1],Thickness[0.0025]}(*blue*)
}
];

The SD line

The points in a scatter diagram generally seem to cluster around the SD line (red)
The SD line goes through two sets of points:
-  all points which are an equal number of SDs away from the average
-  through the point of both fathers'- and sons' heights average

from the SD line to the regression line

The Fathers who are one SD above the average fathers' height are plotted on the orange dashed line. The sons who are also one SD above average sons' height are plotted on the yellow dashed lines. Both dashed lines intersect as expected on the red SD line (as one would expect). 
  However, most of the points along the orange dashed line are below the yellow dashed line. In other words, most of the sons whose fathers were one SD above average fathers height were quite a bit smaller than than one SD above average sons' height. This is where the correlation of 0.5 comes in place. Associated with an increase of one SD in fathers' height is an increase of only 0.5 SDs of sons' height, on the average. That point is exactly where the blue solid line intersects the orange dashed line (the regression line).

PlotOneSDRightofFathersMean=ListLinePlot[{{OneSDrightofMean,0},{OneSDrightofMean,100}}
,PlotStyle->{Orange,Dashed,Thick}];
PlotOneSDTopOfSonsMean=Plot[MY+SDevY,{x,0,80}
,PlotStyle->{Yellow,Dashed,Thick}];
Show[GaltonScatter,
Graphics[{GrayLevel[0.8],Thickness[0.01],q[[1]]}],
Graphics[{GrayLevel[0.5],Thickness[0.005],q[[2]]}],
Graphics[{GrayLevel[0.1],Thickness[0.001],q[[3]]}],
LinesCPH,
PlotOneSDRightofFathersMean
,PlotOneSDTopOfSonsMean]

construct a histogram along the dashed orange line

boundaries for histogram

MultFact=0.15
Lower=MX+(1-MultFact)*SDevX
Upper=MX+(1+MultFact)*SDevX
PointsAt1SDX=Select[GaltonDat,#[[2]]>Lower&&#[[2]]<Upper&];
Length[PointsAt1SDX]

Histogram[PointsAt1SDX[[All,1]],{1.0}
,Epilog->{
First@ListLinePlot[{{rPosition,0},{rPosition,100}}
,PlotStyle->{Green,Thickness[0.01]}],
First@ListLinePlot[{{MY+SDevY,0},{MY+SDevY,100}}
,PlotStyle->{Red,Dashed,Thickness[0.01]}]
}
]
rPosition=intercept1+slope1*OneSDrightofMean
sdPosition=MY+SDevY

Check relation between red and green line

sdPosition-rPosition
r*SDevY

find out how many points in the scatter plot are above the regression line

The Regression line is given as 
regrLine = intercept1 + slope1*x
Let's find out how many points in the original scatter lie abov it

PointsAboveRegrLine=Select[GaltonDat,#[[2]]>intercept1+slope1*#[[1]]&];
Length[PointsAboveRegrLine]
Length[GaltonDat]
Length[PointsAboveRegrLine]/Length[GaltonDat]//N

find out how many points in the scatter plot are above the regression line

The SD line is given as 
SDLine = slope2*x + intercept2
Let's find out how many points in the original scatter lie abov it

PointsAboveSDLine=Select[GaltonDat,#[[2]]>slope2*#[[1]]+intercept2&];
Length[PointsAboveSDLine]
Length[GaltonDat]
Length[PointsAboveSDLine]/Length[GaltonDat]//N