Robust measures of central tendency and dispersion - Maple Programming Help

Home : Support : Online Help : Applications and Example Worksheets : Statistics : examples/RobustStatistics

Robust measures of central tendency and dispersion

Robust statistics seek to describe data sets that suffer from noisy measurements. In particular, they should remain meaningful when a fraction of the data is changed dramatically.

 > with(Statistics):

Robust Measures of Dispersion

A measure of dispersion, also known as a measure of scale, is a statistic of a data set that describes the variability or spread of that data set. Two well-known examples are the standard deviation and the interquartile range. Two more measures of dispersion are called $\mathrm{Sn}$ and $\mathrm{Qn}$, originally proposed by Rousseeuw and Croux [1].

Let us investigate how measures of dispersion behave when noise is added to a data set. Specifically, we will have an original data set $X$ of, say, $n$ data points, and a perturbed data set $Y$ where a certain fraction $rn$ of the data points are changed dramatically. We investigate at what value of $r$ the values become meaningless.

 > X := Sample(Normal(0, 1), 1000);
 ${X}{≔}\left[\begin{array}{cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc}{-}{1.07242412799827}& {-}{0.329077870547065}& {-}{0.617091936909790}& {0.214466745245291}& {-}{0.0254281280423846}& {1.72882128417783}& {-}{1.63485675434390}& {1.57117217175430}& {0.170358421410408}& {1.00647840875181}& {0.268712679158310}& {-}{1.46598044695878}& {-}{0.0357578538394966}& {-}{0.00650336346263664}& {-}{0.0571830022332381}& {-}{0.184600094624929}& {0.203855402371112}& {-}{0.0988718240271234}& {-}{0.0826980970419822}& {-}{0.168119128121408}& {0.162021299867933}& {-}{0.675918709672617}& {-}{0.440797644048532}& {0.896019985259550}& {0.461022953380023}& {1.27797705227385}& {0.234565961794581}& {-}{0.0362744912936830}& {-}{0.448848123512147}& {-}{1.16737308532471}& {-}{1.21794288394124}& {-}{1.15469196092625}& {0.109659323283598}& {-}{0.619809380641282}& {0.642151004644923}& {-}{0.170770918098244}& {-}{0.820052241027982}& {1.34633519663234}& {-}{0.986038560158125}& {-}{0.965838793499848}& {-}{1.36462571980574}& {1.65007871956408}& {1.34804151352017}& {-}{1.02537392618659}& {0.229788060863910}& {1.48493457968053}& {-}{1.30030905411587}& {-}{0.376131116236207}& {0.0617841966672065}& {0.801907829141039}& {-}{0.129975470550859}& {0.112484530604133}& {0.630360591794658}& {-}{0.0208959396841725}& {-}{0.830442822997399}& {-}{0.262652510141184}& {-}{0.700300261968008}& {1.95556905861273}& {-}{0.259474165622608}& {-}{0.0820850625624299}& {1.21557945262500}& {-}{0.983131813759657}& {1.93069064888935}& {0.122735108586753}& {0.432945421151540}& {-}{0.524443817862805}& {0.224215551927832}& {-}{0.414225568098372}& {0.0355261362296387}& {1.98371209767999}& {2.21337958939036}& {0.881229888626876}& {0.886856450560421}& {-}{0.861665947308802}& {-}{0.906611303340893}& {-}{0.876730984349719}& {-}{0.217490459619989}& {-}{0.336155174289136}& {0.549376576019130}& {-}{1.19754843404833}& {-}{0.927510339539523}& {-}{1.32995060542228}& {-}{1.13043603146978}& {1.27187025067002}& {-}{1.47651546344906}& {1.61338249093609}& {-}{0.685342069367486}& {1.08241290092064}& {-}{0.776734900479867}& {-}{0.555481438094644}& {1.07239184776825}& {0.0713529776295548}& {-}{0.182122924489555}& {0.628549543618577}& {-}{0.725850645010288}& {-}{0.413380338600023}& {1.54241530115661}& {-}{0.220309427423809}& {-}{0.840816024752715}& {0.385066012066646}& {\mathrm{...}}& {"... 900 row vector entries not shown"}\end{array}\right]$ (1)
 > StandardDeviation(X);
 ${0.990176940818334}$ (2)
 > Y := copy(X);
 ${Y}{≔}\left[\begin{array}{cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc}{-}{1.07242412799827}& {-}{0.329077870547065}& {-}{0.617091936909790}& {0.214466745245291}& {-}{0.0254281280423846}& {1.72882128417783}& {-}{1.63485675434390}& {1.57117217175430}& {0.170358421410408}& {1.00647840875181}& {0.268712679158310}& {-}{1.46598044695878}& {-}{0.0357578538394966}& {-}{0.00650336346263664}& {-}{0.0571830022332381}& {-}{0.184600094624929}& {0.203855402371112}& {-}{0.0988718240271234}& {-}{0.0826980970419822}& {-}{0.168119128121408}& {0.162021299867933}& {-}{0.675918709672617}& {-}{0.440797644048532}& {0.896019985259550}& {0.461022953380023}& {1.27797705227385}& {0.234565961794581}& {-}{0.0362744912936830}& {-}{0.448848123512147}& {-}{1.16737308532471}& {-}{1.21794288394124}& {-}{1.15469196092625}& {0.109659323283598}& {-}{0.619809380641282}& {0.642151004644923}& {-}{0.170770918098244}& {-}{0.820052241027982}& {1.34633519663234}& {-}{0.986038560158125}& {-}{0.965838793499848}& {-}{1.36462571980574}& {1.65007871956408}& {1.34804151352017}& {-}{1.02537392618659}& {0.229788060863910}& {1.48493457968053}& {-}{1.30030905411587}& {-}{0.376131116236207}& {0.0617841966672065}& {0.801907829141039}& {-}{0.129975470550859}& {0.112484530604133}& {0.630360591794658}& {-}{0.0208959396841725}& {-}{0.830442822997399}& {-}{0.262652510141184}& {-}{0.700300261968008}& {1.95556905861273}& {-}{0.259474165622608}& {-}{0.0820850625624299}& {1.21557945262500}& {-}{0.983131813759657}& {1.93069064888935}& {0.122735108586753}& {0.432945421151540}& {-}{0.524443817862805}& {0.224215551927832}& {-}{0.414225568098372}& {0.0355261362296387}& {1.98371209767999}& {2.21337958939036}& {0.881229888626876}& {0.886856450560421}& {-}{0.861665947308802}& {-}{0.906611303340893}& {-}{0.876730984349719}& {-}{0.217490459619989}& {-}{0.336155174289136}& {0.549376576019130}& {-}{1.19754843404833}& {-}{0.927510339539523}& {-}{1.32995060542228}& {-}{1.13043603146978}& {1.27187025067002}& {-}{1.47651546344906}& {1.61338249093609}& {-}{0.685342069367486}& {1.08241290092064}& {-}{0.776734900479867}& {-}{0.555481438094644}& {1.07239184776825}& {0.0713529776295548}& {-}{0.182122924489555}& {0.628549543618577}& {-}{0.725850645010288}& {-}{0.413380338600023}& {1.54241530115661}& {-}{0.220309427423809}& {-}{0.840816024752715}& {0.385066012066646}& {\mathrm{...}}& {"... 900 row vector entries not shown"}\end{array}\right]$ (3)
 > Y[1] := 10^100:
 > StandardDeviation(Y);
 ${3.16227766016838}{}{{10}}^{{98}}$ (4)

For the standard deviation, we see that changing only one data point can massively change the standard deviation. In other words, there is no positive fraction $r$ of the data points that we can change while keeping the standard deviation bounded. We say that the breakdown point of the standard deviation is 0.

For the interquartile range, the process is different. Changing a single data point doesn't make the interquartile range of $Y$ change very much; in fact, we can change up to a quarter of the data points while staying within an order of magnitude from the interquartile range of $X$. As soon as we have changed 250 out of the 1000 data points, though, the interquartile range also goes through the roof.

 > InterquartileRange(X);
 ${1.36849073417322}$ (5)
 > Y := copy(X);
 ${Y}{≔}\left[\begin{array}{cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc}{-}{1.07242412799827}& {-}{0.329077870547065}& {-}{0.617091936909790}& {0.214466745245291}& {-}{0.0254281280423846}& {1.72882128417783}& {-}{1.63485675434390}& {1.57117217175430}& {0.170358421410408}& {1.00647840875181}& {0.268712679158310}& {-}{1.46598044695878}& {-}{0.0357578538394966}& {-}{0.00650336346263664}& {-}{0.0571830022332381}& {-}{0.184600094624929}& {0.203855402371112}& {-}{0.0988718240271234}& {-}{0.0826980970419822}& {-}{0.168119128121408}& {0.162021299867933}& {-}{0.675918709672617}& {-}{0.440797644048532}& {0.896019985259550}& {0.461022953380023}& {1.27797705227385}& {0.234565961794581}& {-}{0.0362744912936830}& {-}{0.448848123512147}& {-}{1.16737308532471}& {-}{1.21794288394124}& {-}{1.15469196092625}& {0.109659323283598}& {-}{0.619809380641282}& {0.642151004644923}& {-}{0.170770918098244}& {-}{0.820052241027982}& {1.34633519663234}& {-}{0.986038560158125}& {-}{0.965838793499848}& {-}{1.36462571980574}& {1.65007871956408}& {1.34804151352017}& {-}{1.02537392618659}& {0.229788060863910}& {1.48493457968053}& {-}{1.30030905411587}& {-}{0.376131116236207}& {0.0617841966672065}& {0.801907829141039}& {-}{0.129975470550859}& {0.112484530604133}& {0.630360591794658}& {-}{0.0208959396841725}& {-}{0.830442822997399}& {-}{0.262652510141184}& {-}{0.700300261968008}& {1.95556905861273}& {-}{0.259474165622608}& {-}{0.0820850625624299}& {1.21557945262500}& {-}{0.983131813759657}& {1.93069064888935}& {0.122735108586753}& {0.432945421151540}& {-}{0.524443817862805}& {0.224215551927832}& {-}{0.414225568098372}& {0.0355261362296387}& {1.98371209767999}& {2.21337958939036}& {0.881229888626876}& {0.886856450560421}& {-}{0.861665947308802}& {-}{0.906611303340893}& {-}{0.876730984349719}& {-}{0.217490459619989}& {-}{0.336155174289136}& {0.549376576019130}& {-}{1.19754843404833}& {-}{0.927510339539523}& {-}{1.32995060542228}& {-}{1.13043603146978}& {1.27187025067002}& {-}{1.47651546344906}& {1.61338249093609}& {-}{0.685342069367486}& {1.08241290092064}& {-}{0.776734900479867}& {-}{0.555481438094644}& {1.07239184776825}& {0.0713529776295548}& {-}{0.182122924489555}& {0.628549543618577}& {-}{0.725850645010288}& {-}{0.413380338600023}& {1.54241530115661}& {-}{0.220309427423809}& {-}{0.840816024752715}& {0.385066012066646}& {\mathrm{...}}& {"... 900 row vector entries not shown"}\end{array}\right]$ (6)
 > Y[1 .. 249] := 10^100:
 > InterquartileRange(Y);
 ${3.30395809676134}$ (7)
 > Y[250] := 10^100:
 > InterquartileRange(Y);
 ${5.83333333333371}{}{{10}}^{{99}}$ (8)

This suggests that the breakdown point of the interquartile range is $\frac{1}{4}$: changing strictly fewer than $\frac{1}{4}$ of the points cannot make the interquartile range unbounded. This is indeed correct. We say that the interquartile range is more robust than the standard deviation.

The breakdown point for any statistic can never be more than $\frac{1}{2}$: if we change over half of the data points in the set, then there's no way to decide what the "correct" data is, and what the "changed" data is. So are there dispersion statistics that reach this maximal breakdown point?

Yes, there are. A relatively well-known one is the median absolute deviation from the median, available in Maple as MedianDeviation. As the name says, it is obtained by computing the absolute difference between every data point and the median of the data set, and taking the median of these values.

 > MedianDeviation(X);
 ${0.686396253277771}$ (9)
 > Y := copy(X):
 > Y[1 .. 499] := 10^100:
 > MedianDeviation(Y);
 ${5.37556591483202}$ (10)
 > Y[500] := 10^100:
 > MedianDeviation(Y);
 ${5.00000000000000}{}{{10}}^{{99}}$ (11)

The median absolute deviation from the median is a very useful robust estimator, but it also has some disadvantages, explained in the paper [1] by Rousseeuw and Croux. One of their objections is that it doesn't deal with asymmetric distributions very well, and another is that, while it is very robust against extreme changes in some points, it needs relatively many data points to "converge" to the proper value for a distribution in the absence of disturbance. In the statistics literature, this is phrased as saying that the median absolute deviation from the median is not very efficient. These authors propose two alternative statistics that also have a breakdown point of $\frac{1}{2}$ but higher efficiency, called $\mathrm{Sn}$ and $\mathrm{Qn}$. Maple has an implementation of both of these, called RousseeuwCrouxSn and RousseeuwCrouxQn.

 > RousseeuwCrouxSn(X);
 ${0.836306393200841}$ (12)
 > RousseeuwCrouxQn(X);
 ${0.453501081152612}$ (13)
 > Y := copy(X):
 > Y[1 .. 499] := 10^100:
 > RousseeuwCrouxSn(Y);
 ${5.64926532313226}$ (14)
 > RousseeuwCrouxQn(Y);
 ${0.0137805612041167}$ (15)
 > Y[500] := 10^100:
 > RousseeuwCrouxSn(Y);
 ${1.00000000000000}{}{{10}}^{{100}}$ (16)
 > RousseeuwCrouxQn(Y);
 ${0.00711405767220685}$ (17)

The $\mathrm{Qn}$ estimator requires a different pattern to break:

 > Y := copy(X):
 > Y[1..499] := Vector(499, i -> i * 10^97):
 > RousseeuwCrouxQn(Y);
 ${5.64926532313226}$ (18)
 > Y[500] := 500 * 10^97:
 > RousseeuwCrouxQn(Y);
 ${1.00000000000000}{}{{10}}^{{97}}$ (19)

We will show how all of these statistics deviate from their true value for beta-distributed data samples at sample sizes from 10 to 10000 and with fractions between $0$ and $\frac{1}{2}$ of the data replaced by the value $5$. In particular, given the sample size and the fraction $r$, we replace the highest $100r$ percent of the data by $5$, then divide value obtained for the changed sample by the true value for the distribution, thus obtaining a number that should be $1$ for an ideal statistic. We then repeat this $100$ times, and take the average squared difference from $1$. This is the number shown in the plot below for each of the five measures of dispersion discussed above.

 > functions := [StandardDeviation, InterquartileRange, MedianDeviation, RousseeuwCrouxSn, RousseeuwCrouxQn]:
 > nf := numelems(functions):
 > X := Sample(BetaDistribution(0.9, 1.7), 10^6):
 > true_values := map(f -> f(X), functions);
 ${\mathrm{true_values}}{≔}\left[{0.250723438655674}{,}{0.398600335400938}{,}{0.191975118167636}{,}{0.229890358142317}{,}{0.107737972480062}\right]$ (20)
 > sample_sizes := [10, 30, 100, 300, 1000, 3000, 10000]:
 > nss := numelems(sample_sizes):
 > results := Array(1 .. nf, 1 .. nss, 0 .. 10, 1 .. 100);
 ${\mathrm{results}}{≔}\left[\begin{array}{ccccccc}{0}& {0}& {0}& {0}& {0}& {0}& {0}\\ {0}& {0}& {0}& {0}& {0}& {0}& {0}\\ {0}& {0}& {0}& {0}& {0}& {0}& {0}\\ {0}& {0}& {0}& {0}& {0}& {0}& {0}\\ {0}& {0}& {0}& {0}& {0}& {0}& {0}\\ {}& {}& {}& {}& {}& {}& {"slice of 1 .. 5 × 1 .. 7 × 0 .. 10 × 1 .. 100 Array"}\end{array}\right]$ (21)
 > for k to 100 do     X := Sample(BetaDistribution(0.9, 1.7), max(sample_sizes));     for i to nss do         Y := X[1 .. sample_sizes[i]];         sort[inplace](Y, >):         for j from 0 to 10 do             Y[1 .. ceil(j * sample_sizes[i] / 20)] := 5;             for f to nf do                 results[f, i, j, k] := functions[f](Y) / true_values[f];             end do;         end do;     end do: end do:
 > rr := Array(1 .. nf, 1 .. nss, 0 .. 10):
 > for i to nss do     for j from 0 to 10 do         for f to nf do             rr[f,i,j] := sqrt(Moment(results[f, i, j], 2, origin = 1));         end do:     end do: end do:
 > plots:-display(plots:-surfdata~([seq(convert(rr[i], Matrix), i=1 .. nf)], 1 .. nss, 0 .. 0.5,                                 color =~ [red, green, blue, yellow, purple], transparency = 0.2),                axis[1]=[tickmarks=[seq(i = sample_sizes[i], i = 1 .. nss)]], axis[3]=[mode=log],                view=[DEFAULT,DEFAULT, min(rr) .. 10], orientation=[116, -68, 177],                labels=[Sample sizes, r, Standard deviation],                labeldirections=[horizontal, horizontal, vertical]);

The colors are red for the standard deviation, green for the interquartile range, blue for the median absolute deviation from the median, yellow for Rousseeuw and Croux' $\mathrm{Sn}$, and purple for $\mathrm{Qn}$. Lower numbers are shown higher in the graph, and are better. We see that in the case where there is no noise ($r=0$), the standard deviation has the lowest distortion. However, as soon as there is any distortion, it is immediately too inaccurate to be useful for any purpose. For $r<0.25$, the interquartile range (green) does reasonably well, but greater values of $r$ make it, too, unusable. For larger values, the median absolute deviation from the median (blue), $\mathrm{Sn}$ (yellow), and $\mathrm{Qn}$ (purple) all do reasonably well.

Another interesting experiment is to see how these measures of dispersion distinguish two Cauchy distributions with different scale parameters. We can see that the values in $\mathrm{X2}$ (plotted in green, below) are just a little further spread out than those in $\mathrm{X1}$ (plotted in red). Indeed, one could obtain a sample of the distribution underlying $\mathrm{X2}$ by multiplying a sample from the distribution underlying $\mathrm{X1}$ by $1.1$. It would be nice if measures of dispersion reflect this fact. However, the Cauchy distribution naturally has many outliers, and indeed the standard deviation of the distribution is undefined.

 > X1 := Sample(Cauchy(0, 1.0), 10^5):
 > X2 := Sample(Cauchy(0, 1.1), 10^5):
 > plots:-display(KernelDensityPlot~([X1, X2], left=-12, right=12, color =~ [red, green]));
 > for i to nf do   f1 := functions[i](X1);   f2 := functions[i](X2);   print(convert(functions[i], 'string'), f1, f2, f2/f1); end do:
 ${"StandardDeviation"}{,}{449.338396768261}{,}{369.193670033710}{,}{0.821638374750591}$
 ${"InterquartileRange"}{,}{1.98067531812334}{,}{2.19917468715040}{,}{1.11031559136814}$
 ${"MedianDeviation"}{,}{0.990085222109834}{,}{1.09982427847032}{,}{1.11083799041727}$
 ${"RousseeuwCrouxSn"}{,}{1.40295106271317}{,}{1.55594539119706}{,}{1.10905179271757}$
 ${"RousseeuwCrouxQn"}{,}{0.822708625248383}{,}{0.911513513961144}{,}{1.10794209029467}$ (22)

We see that all measures of dispersion with a breakpoint greater than $0$, that is, all of them except for the standard deviation, reproduce this ratio of $1.1$ fairly closely.

Robust measures of central tendency

A measure of central tendency is a statistic that identifies a central value in a sample or distribution. Well-known examples are the Mean, the Median, and the Mode. Another measure of central tendency was invented by Hodges and Lehmann (see [2]) and independently by Sen (see [3]); it is often called the Hodges-Lehmann estimator.

We can study the breakdown point of these quantities as we did with the measures of dispersion. For the mean, the breakdown point is $0$.

 > X := Sample(Normal(0, 1), 1000);
 ${X}{≔}\left[\begin{array}{cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc}{0.426296961696166}& {-}{0.525440042620138}& {-}{0.715048097498091}& {-}{0.430349780534935}& {-}{1.68175442866554}& {-}{1.89239970570250}& {-}{0.957957498304262}& {-}{1.62568584636518}& {-}{1.16819784647748}& {-}{0.899348752771789}& {-}{0.196972183901307}& {-}{0.171257004047871}& {-}{0.185930364731826}& {0.0791404184167641}& {-}{1.68828175204416}& {-}{0.856970085559983}& {-}{1.18528049646972}& {-}{0.0851589091497669}& {1.46503344035636}& {-}{0.0458547093077000}& {-}{0.00109019699554147}& {0.300376115309924}& {-}{0.639670432503370}& {1.76429620749976}& {1.63780882477334}& {1.68116888781951}& {0.157660013874575}& {-}{1.71081797329246}& {2.08774737059095}& {-}{0.718914192617857}& {0.976153284099872}& {-}{0.722678995851021}& {0.773992890989649}& {0.0297947811098078}& {-}{1.52566183965206}& {-}{2.86920085140933}& {2.70997599598822}& {-}{0.0284186080098589}& {-}{0.342041605265709}& {-}{1.45682934179374}& {1.32592679222920}& {1.51262459399524}& {-}{2.13912925952372}& {-}{1.49378477811148}& {0.895522399241348}& {0.259345716971229}& {-}{0.377118350396605}& {-}{0.791955112565435}& {1.06393641173055}& {-}{2.42675440984513}& {0.766787469500260}& {-}{0.971037596023150}& {-}{0.688162414111648}& {-}{0.938431450312904}& {-}{0.877566035097889}& {-}{0.552048904889983}& {-}{0.437426116600806}& {2.21392807644197}& {0.188682139182442}& {-}{0.826109857506029}& {-}{0.894011569882974}& {2.75279588021957}& {-}{2.18150116214478}& {-}{1.34531382535366}& {0.587027284377018}& {0.896739165314419}& {0.517306231640586}& {0.0819177872465470}& {-}{0.812443981522881}& {-}{2.41200034706173}& {-}{0.0516388647762058}& {2.01198081868946}& {1.80095025243189}& {-}{0.235139177479329}& {-}{0.168801516749904}& {-}{1.64394311714492}& {-}{1.49369742211538}& {-}{0.668005395974602}& {-}{1.80987734861954}& {-}{1.28301153795749}& {0.0977340853788572}& {0.147100076370955}& {0.516388738748625}& {0.541399584152324}& {-}{1.40063650529919}& {-}{0.522594439530305}& {-}{1.23721600256126}& {-}{0.189048219389805}& {0.280097834163145}& {-}{1.82400702465715}& {1.32005399706143}& {-}{0.389288810552386}& {-}{0.818735144570617}& {0.661283769924477}& {-}{1.33420213279696}& {1.89102080691236}& {-}{0.0176134807628491}& {-}{1.58521581593738}& {-}{0.0648416792030421}& {-}{0.871434563191686}& {\mathrm{...}}& {"... 900 row vector entries not shown"}\end{array}\right]$ (23)
 > Mean(X);
 ${-}{0.0440433853151993}$ (24)
 > Y := copy(X);
 ${Y}{≔}\left[\begin{array}{cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc}{0.426296961696166}& {-}{0.525440042620138}& {-}{0.715048097498091}& {-}{0.430349780534935}& {-}{1.68175442866554}& {-}{1.89239970570250}& {-}{0.957957498304262}& {-}{1.62568584636518}& {-}{1.16819784647748}& {-}{0.899348752771789}& {-}{0.196972183901307}& {-}{0.171257004047871}& {-}{0.185930364731826}& {0.0791404184167641}& {-}{1.68828175204416}& {-}{0.856970085559983}& {-}{1.18528049646972}& {-}{0.0851589091497669}& {1.46503344035636}& {-}{0.0458547093077000}& {-}{0.00109019699554147}& {0.300376115309924}& {-}{0.639670432503370}& {1.76429620749976}& {1.63780882477334}& {1.68116888781951}& {0.157660013874575}& {-}{1.71081797329246}& {2.08774737059095}& {-}{0.718914192617857}& {0.976153284099872}& {-}{0.722678995851021}& {0.773992890989649}& {0.0297947811098078}& {-}{1.52566183965206}& {-}{2.86920085140933}& {2.70997599598822}& {-}{0.0284186080098589}& {-}{0.342041605265709}& {-}{1.45682934179374}& {1.32592679222920}& {1.51262459399524}& {-}{2.13912925952372}& {-}{1.49378477811148}& {0.895522399241348}& {0.259345716971229}& {-}{0.377118350396605}& {-}{0.791955112565435}& {1.06393641173055}& {-}{2.42675440984513}& {0.766787469500260}& {-}{0.971037596023150}& {-}{0.688162414111648}& {-}{0.938431450312904}& {-}{0.877566035097889}& {-}{0.552048904889983}& {-}{0.437426116600806}& {2.21392807644197}& {0.188682139182442}& {-}{0.826109857506029}& {-}{0.894011569882974}& {2.75279588021957}& {-}{2.18150116214478}& {-}{1.34531382535366}& {0.587027284377018}& {0.896739165314419}& {0.517306231640586}& {0.0819177872465470}& {-}{0.812443981522881}& {-}{2.41200034706173}& {-}{0.0516388647762058}& {2.01198081868946}& {1.80095025243189}& {-}{0.235139177479329}& {-}{0.168801516749904}& {-}{1.64394311714492}& {-}{1.49369742211538}& {-}{0.668005395974602}& {-}{1.80987734861954}& {-}{1.28301153795749}& {0.0977340853788572}& {0.147100076370955}& {0.516388738748625}& {0.541399584152324}& {-}{1.40063650529919}& {-}{0.522594439530305}& {-}{1.23721600256126}& {-}{0.189048219389805}& {0.280097834163145}& {-}{1.82400702465715}& {1.32005399706143}& {-}{0.389288810552386}& {-}{0.818735144570617}& {0.661283769924477}& {-}{1.33420213279696}& {1.89102080691236}& {-}{0.0176134807628491}& {-}{1.58521581593738}& {-}{0.0648416792030421}& {-}{0.871434563191686}& {\mathrm{...}}& {"... 900 row vector entries not shown"}\end{array}\right]$ (25)
 > Y[1] := 10^100:
 > Mean(Y);
 ${1.00000000000000}{}{{10}}^{{97}}$ (26)

The mode is a little tricky to handle for a continuous probability distribution given by a sample. The median is clearer; its breakdown point is $\frac{1}{2}$.

 > Median(X);
 ${-}{0.0517980929073610}$ (27)
 > Y[1..499] := 10^100:
 > Median(Y);
 ${3.28336678887124}$ (28)
 > Y[500] := 10^100:
 > Median(Y);
 ${5.00000000000000}{}{{10}}^{{99}}$ (29)

The Hodges-Lehmann estimator has a breakdown point of $1-\frac{\sqrt{2}}{2}$ or about $0.29$.

 > HodgesLehmann(X);
 ${-}{0.0448012388157054}$ (30)
 > Y := copy(X):
 > Y[1..292] := 10^100:
 > HodgesLehmann(Y);
 ${2.03087993094348}$ (31)
 > Y[293] := 10^100:
 > HodgesLehmann(Y);
 ${5.00000000000000}{}{{10}}^{{99}}$ (32)

The advantage of the Hodges-Lehmann estimator is that it converges to its limit value more quickly than the median does (at least for distributions that are symmetric about the median); that is, for relatively small sample sizes, the Hodges-Lehmann estimator has greater accuracy. We proceed as in the previous section.

 > functions := [Mean, Median, HodgesLehmann];
 ${\mathrm{functions}}{≔}\left[{\mathrm{Statistics}}{:-}{\mathrm{Mean}}{,}{\mathrm{Statistics}}{:-}{\mathrm{Median}}{,}{\mathrm{Statistics}}{:-}{\mathrm{HodgesLehmann}}\right]$ (33)
 > nf := numelems(functions):
 > X := Sample(BetaDistribution(0.9, 1.7), 10^6):
 > true_values := map(f -> f(X), functions);
 ${\mathrm{true_values}}{≔}\left[{0.346168635394193}{,}{0.302645078252079}{,}{0.334386724583336}\right]$ (34)
 > sample_sizes := [10, 30, 100, 300, 1000, 3000, 10000]:
 > nss := numelems(sample_sizes):
 > results := Array(1 .. nf, 1 .. nss, 0 .. 10, 1 .. 100);
 ${\mathrm{results}}{≔}\left[\begin{array}{ccccccc}{0}& {0}& {0}& {0}& {0}& {0}& {0}\\ {0}& {0}& {0}& {0}& {0}& {0}& {0}\\ {0}& {0}& {0}& {0}& {0}& {0}& {0}\\ {}& {}& {}& {}& {}& {}& {"slice of 1 .. 3 × 1 .. 7 × 0 .. 10 × 1 .. 100 Array"}\end{array}\right]$ (35)
 > for k to 100 do     X := Sample(BetaDistribution(0.9, 1.7), max(sample_sizes));     for i to nss do         Y := X[1 .. sample_sizes[i]];         sort[inplace](Y, >):         for j from 0 to 10 do             Y[1 .. ceil(j * sample_sizes[i] / 20)] := 5;             for f to nf do                 results[f, i, j, k] := functions[f](Y) / true_values[f];             end do;         end do;     end do: end do:
 > rr := Array(1 .. nf, 1 .. nss, 0 .. 10):
 > for i to nss do     for j from 0 to 10 do         for f to nf do             rr[f,i,j] := sqrt(Moment(results[f, i, j], 2, origin = 1));         end do:     end do: end do:
 > plots:-display(plots:-surfdata~([seq(convert(rr[i], Matrix), i=1 .. nf)], 1 .. nss, 0 .. 0.5,                                 color =~ [red, green, blue], transparency = 0.2),                axis[1]=[tickmarks=[seq(i = sample_sizes[i], i = 1 .. nss)]], axis[3]=[mode=log],                view=[DEFAULT,DEFAULT, min(rr) .. 10], orientation=[116, -68, 177],                labels=[Sample sizes, r, Standard deviation],                labeldirections=[horizontal, horizontal, vertical]);

We see that the mean (in red) performs best when $r=0$, but miserably otherwise. The Hodges-Lehmann estimator behaves very well for $r<0.29$. Beyond that only the median does well.

We can also reproduce the experiment with the Cauchy distribution. We now vary the location parameter between the two samples; the values in $\mathrm{X2}$ (plotted in green, below) are just a little further to the right, that is, greater, than those in $\mathrm{X1}$ (plotted in red). In this case, one could obtain a sample of the distribution underlying $\mathrm{X2}$ by adding $0.1$ to a sample from the distribution underlying $\mathrm{X1}$. It would be nice if measures of central tendency reflect this fact. However, the Cauchy distribution does not have a mean.

 > X1 := Sample(Cauchy(0.0, 1), 10^5):
 > X2 := Sample(Cauchy(0.1, 1), 10^5):
 > plots:-display(KernelDensityPlot~([X1, X2], left=-12, right=12, color =~ [red, green]));
 > for i to nf do   f1 := functions[i](X1);   f2 := functions[i](X2);   print(convert(functions[i], 'string'), f1, f2, f2-f1); end do:
 ${"Mean"}{,}{3.75928740374888}{,}{-}{0.731653076359264}{,}{-}{4.49094048010814}$
 ${"Median"}{,}{-}{0.00155169275765436}{,}{0.108266946816597}{,}{0.109818639574252}$
 ${"HodgesLehmann"}{,}{-}{0.00247725147498823}{,}{0.102976972631938}{,}{0.105454224106927}$ (36)
 >

Again, we see that the two measures of central tendency with breakpoint greater than $0$ (that is, the median and the Hodges-Lehmann estimator) reproduce this difference of $0.1$ correctly, whereas the mean (with breakpoint $0$) does not.