2021-01-14-and-have-you-seen-the-rasch-sampler.Rmd

---
title: And have you seen the Rasch sampler?
author: Ivailo Partchev
date: '2021-01-14'
slug: and-have-you-seen-the-rasch-sampler
bibliography: dexter.bib
categories:
  - Psychometrics
  - R
tags: []
---

_Our most distinguished colleague, Norman D. Verhelst, had his birthday a couple of days ago. As a tiny tribute, I offer a lecture I gave a couple of months ago to a bunch of students. They had moderate exposure to statistics, and I have edited it somewhat hastily, so the level is not particularly uniform --- sorry, folks._

The RaschSampler [@RaschSampler] is an R package that allows the user to test a vast array of statistical hypotheses about the Rasch model. It is also a good example of how the statistical testing of hypotheses works, especially in its nonparametric variety.

The theory behind the RaschSampler seems to go back to Georg Rasch himself. In a nutshell: Since the row sums and the column sums in a 0/1 matrix are sufficient statistics for the person parameters and the item parameters in the Rasch model, correspondingly, then any other matrix having the same marginal sums will be just as compatible with the Rasch model in terms of measurement. If we compute a statistic of interest on all matrices having the same marginal sums as our observed matrix, then we can place the statistic for the observed matrix in the distribution of all statistics. The statistic itself can be anything: if you compute the matrix of tetrachoric correlations between all items, divide its seventh eigenvalue by the first, take the log and multiply it by Boltzmann's constant, it would still work (now, try and derive the asymptotic distribution of this statistic). 

Of course, we would like to use sensible statistics --- @Ponocny2001 gives many useful examples. And we wouldn't like to work with _all_ matrices having the same marginal sums, because there are so many of them. But, if we can have a program that produces, efficiently, a representative sample of them, the practical interest is obvious. The key to the problem was given by @VerhelstMCMC.

As implemented in the RaschSampler package, the procedure produces a prespecified number of unbiased samples from the sample space of all possible 0/1 matrices of the same size and having the same sum and row sums as the user-specified matrix. The user must provide a function that computes some statistic of interest on each of these matrices. It is then trivial to place the statistic for the observed data matrix in the resulting distribution of statistics, and compute the p-value,

For didactic purposes, I start with a function that draws a sample from the bivariate normal distribution. This can be accomplished in a variety of ways but, since the Rasch Sampler is an MCMC method, I have chosen a Gibbs sampler algorithm [see @BDA2, p.288f]:



```r
gibbs = function (n, m1=0, s1=1, m2=0, s2=1, rho=0)
{
  m = matrix(ncol = 2, nrow = n)
  x = y = 0
  for (i in 1:n) {
    x = rnorm(1, m1+(s1/s2) * rho * (y-m2), sqrt((1-rho^2)*s1^2))
    y = rnorm(1, m2+(s2/s1) * rho * (x-m1), sqrt((1-rho^2)*s2^2))
    m[i, ] = c(x, y)
  }
  m
}
```

`m1` and `m2` are the two means, `s1` and `s2` the two standard deviations, and `rho` is the correlation coefficient. Let us test the function by drawing a small sample of 10 number pairs and computing the correlation:


```r
cor(gibbs(10, rho=.3))
```

```
##           [,1]      [,2]
## [1,] 1.0000000 0.4265842
## [2,] 0.4265842 1.0000000
```

The first time I did this in front of the students, the correlation was close to -.3, so the question is whether there could be a programming mistake. Given a sample size of 10, how compatible is an observed correlation of -.3 with a true value of +.3?

The answer to this question is very similar to the answers provided by the Rasch Sampler. We can create some frame of reference for our observed value by drawing many samples of the same type and size. Each sample will yield another correlation, and these form a distribution. The distribution of the results from all possible samples of the same type and size is called _sampling distribution_, and its standard deviation is known as _standard error_.  Obviously, we cannot obtain the whole sampling distribution as there are infinitely many samples of size 10, but we can do with a largish sample, as long as it is drawn in an impartial way. In R, we can use the `replicate` function:


```r
ten = replicate(1000, cor(gibbs(10, rho=.3))[2,1])
hist(ten)
```

<img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAfgAAAH4CAMAAACR9g9NAAAAtFBMVEUAAAAAADoAAGYAOjoAOmYAOpAAZpAAZrY6AAA6ADo6AGY6OgA6OpA6ZpA6ZrY6kNtmAABmADpmAGZmOgBmZmZmkLZmkNtmtttmtv+QOgCQOjqQOmaQZgCQZjqQZmaQtmaQtpCQttuQ29uQ2/+2ZgC2Zjq2kGa2ttu227a22/+2/7a2///T09PbkDrbkGbbtmbbtpDb2//b/7bb/9vb////tmb/tpD/25D/27b//7b//9v////FixJhAAAACXBIWXMAAAsSAAALEgHS3X78AAAPP0lEQVR4nO2dC3sa1xVFR35U1FEtkjSNFSd9WEpbVyVJU6kE+P//q/MAZCzQ3IvumT2Hs9b3JZbl2RxmLw0zg4CpVhCSSn0HQAPig4L4oCA+KIgPCuKDgvigID4oiA8K4oOC+KAgPiiIDwrig4L4oCA+KIgPCuKDgvigID4oiA8K4oOC+KAgPiiID8rJiV9MX9yuVsurF7fdV2uWP757xo3OJ9XZ9fNvZkycsPidb99UzzG2TT/vZsbECYtvv/rfF1X16uPyqqqq89Xqp3rL/eau/ucfqlf/nL6+W16d/XHy4uP863qh69V99bv6+7c/Tc42drvl2/TrJtbdzPLv9be/bYf8ZVLfunR9j+XExS+mVSPtv52xm+Yvjbnmry8nr9dKf+0Wurtv//ll/d/64WK9/Ofiu29fdn9tf6AccoLiWxtVJ34+aYStusfo+eTsb6v59Ox6PnlxvZpVrfi1tnm98H1Vb/yT6tvFtNuhb5fffaivb/Pj6rd6+Tp9ufq5Wk9wxomLbzbKl9/8pzN231qeVe/aLxbdQ32jePnLn7+oGvHnqy7Uid8uvyu+e2Coj/ba5Zqbka3sMzhB8btH9b/80Dh9Uvxv01f/+HW6Eb/9cUgQX98w4kfC49O55fdrdfse6hvFs+rt6ufJY/FPPdS3N4z4EbEr/n79sN8ckO09uGsUbxb6XPx2+U/Fb2+mWQ7x4+GzLf6XL9ozteYpmPO79vTsT81CX1ev/rVVvPyx/u56D7Ajfrv8Vnx7M8sfJ1X1hzu2eHfMmzN1r4fjhQgpfn0Cfqm+H0pCil/99l19VP428gYfVDwgPiqIDwrig4L4oCA+KIgPCuKDgvigID4oiA8K4oOC+KAgPiiIDwrig4L4oCA+KIgPCuKDgvigID4oiA8K4oOC+KAgPiiIDwrig4L4oCA+KIgPCuKDgvigIP5pqgzU9zULX/d2eKp/J+OrSl/3dngQHxTEBwXxQUF8UBAflMDi55PNJ0BHJK745VX3wc33MT/yN674xVe3O38GI654tvig4jdX92EfH018bBAflLjim4O65tE+5i4+tvj2gH7+doi7MzpCi59f3O2czvl85cFxBBY/PfvwvtniLx491vta0+OIK769ZtP56n7P6ZyvNT2OyOJNsl5AfOGsFwKLn0+q5oqbe56r97WmxxFXfPNc/fLqEvHRxHfCb84RH0z8+rdzs5dvEB9KfH0i3158d/b4fM7Xmh5HYPE2WS8gvnDWC4gvnPUC4gtnvYD4wlkvIL5w1guIL5z1AuILZ72A+MJZLyC+cNYLiC+c9QLiC2e9gPjCWS8gvnDWC4gvnPUC4gtnvYD4wlkvIL5w1guIL5z1AuILZ72A+MJZLyC+cNYLiC+c9QLiC2e9gPjCWS/kiHd1FRPEP02OeFcPDoh/GsQXznoB8YWzXkB84awXEF846wXEF856AfGFs15AfOGsFxBfOOsFxBfOegHxhbNeQHzhrBcQXzjrBcQXznoB8YWzXkB84awXEF846wXEF856AfGFs15AfOGsFxBfOOuFwOLnk0NXkx7B3Tcnrvgnrh8/grtvTlzxm2vRcE2aYOLZ4oOKb68hzj4+oHibrBcQXzjrhcDiOZ2LKZ6Du6Di95zOjehd3ubEFc8WH1Q8p3NRxdtkvYD4wlkvBBZfn86dXfNcfTjxzcHd8uoS8dHEd8JvzhEfTPz6dG728g3iQ4mvT+cumz9mj8/nRnD3zQks3ibrBcQXznoB8YWzXkB84awXEF846wXEF856AfGFs15AfOGsFxBfOOsFxBfOegHxhbNeQHzhrBcQXzjrBcQXznoB8YWzXkB84awXEF846wXEF856AfGFs15AfOGsFxBfOOsFxBfOegHxhbNaMq70jviyWS3pjhBfOKsF8YhH/LBZLYhHPOKHzWpBPOIRP2xWC+IRj/hhs1oQj3jED5vVgnjEI37YrBbEIx7xw2a1IB7xiB82qwXxiEf8sFktiEc84ofNakE84hF/iFO80iTig153DvFHXWkyOTtaEM8Wj/hDnOKVJhG/lreYnh+d9Qjit/Luq/aygkdl/YH4T+Utr6rq3aMFmoO65tH+8S4e8acgvruQ6J5D9/pb7Xfnbw9m/YH47T5+zwbdUVufX9ztnM5tPzRgiDtoAuITzuOnZx/eN1v8BadzJyj+vt67zw4c3dX7/vPVPadzpyh+8WXjfP748rEJWY8gfi2ve3puz5NzCVmPIH4jr316bs+jeUrWIYjn9/GIP8D6qfp9jwcjuPtHgviHo/oDv4hp9v+XT2cdgvjtEziPn6vd0h3yH8x6BPEb8Y+fqk3OegTxG3k3hx7OE7IOQfz2of7wPr4v6xHEczqH+GGzWhC/kbe8ql7/eujovSfrEMRvn6u/nF/c8Vx9OPHdqy1yT+pGcPePBPE7W/yMLT6a+PaFlvteT5mSdQjiOapH/LBZLYjnmbvY4jtmmU/Yj+DuHwnid+RxOhdU/L6XUKdmfYH43X38E6/GOJz1COI5qkf8sFktiN99qM88oRvB3T8SxG/kzc43/8vPOgTxOy+25HQunPjutfNs8eHEd7+dy/0ApBHc/SNBPEf1iB82qwXxvNgytnhebBlUPC+2DCqeF1sOLD4dswq6P3ix5bDi05c0q0CU1YJ43h+vsDke8cvvcj+5+iHrEcTzKluFzfGIHz6rBfGIV9gci/jjDu0QP8Si5uL3fCp5UtYniEe8wibiVSC+E3/Ua2wRP8SiHNUXBfGIV9hEvArEn5L4jF9yI/6kxJsUb3GjPsTPJ06uJo34rLb6FvBz/XjEZ7XVt8Dmifw9T+gj3n5Rtvh+EJ/VVu8Sh1+kgXj7RTmq7wfxWW2JsgYgPqut3iU4nVMuysFdP4jPaqtvgT2nc+Zv7zkOxGe11bcAW7x0UU7n+kF8VluirAGIz2pLlDUA8VltibIGID6rLVHWAMRntdW3wBMvwUW8/aLCLb771MvjsoOC+Ky2+hdZHPoYNMTbL8o+vh/EZ7UlyhqA+Ky2RFkDEJ/VlihrAOKz2hJlDUB8VluirAGIz2pLlDUA8VltibIGID6rLVHWAMRntSXKGoD4rLZEWQMQn9WWKGsA4rPaEmUNQHxWW6KsAYjPakuUNQDxWW2JsgYgPqstUdYAxGe1JcoagPistkRZAxCf1ZYoawDis9oSZQ1AfFZboqwBiM9qS5Q1APFZbYmyBiA+qy1R1gDEZ7UlyhqA+Ky2RFkDEJ/VlihrAOKz2hJlDUB8VluirAGIz2pLlDUA8VltibIGID6rLVHWAMRntSXKGoD4rLZE2eQZFtcUQ7wD8eri1fPNihVlk2eoi1fPNytWlE2eoS5ePd+sWFE2eYa6ePV8s2JF2eQZ6uLV882KFWWTZ6iLV883K1aUTZ6hLl4936xYUTZ5hrp49XyzYkXZ5Bnq4tXzzYoVZZNnqItXzzcrVpRNnqEuXj3frFhRNnmGunj1fLNiRdnkGeri1fPNihVlk2eoi1fPNyu2dwntRYXlxavnmxXbt4D4EqPy4tXzzYrtW2DPRYWTswWQF6+eb1Zs3wJs8dr5ZsX2LqG9qLC8ePV8s2JF2eQZ6uLV882KPSazofi92TNLXbx6vlmxfQs0B3XNo/3jXTxb/BDzzYrtW6AW3x7Qz9/mZwsgL14936zYvgVq6/OLO07nVPPNiu1bYDE9+/C+2eIvOJ1TzDcrtn+R5VV1vrrndE4z36xYUTZ5hrp49XyzYkXZ5Bnq4tXzzYoVZZNnqItXzzcrVpRNnqEuXj3frFhRNnmGunj1fLNiRdnkGeri1fPNihVlk2eoi1fPNytWlE2eoS5ePd+sWFE2eYa6ePV8s2JF2eQZ6uLV882KFWWTZ6iLV883K1aUTZ6hLl4936xYUTZ5hrp49XyzYkXZ5Bnq4tXzzYoVZZNnqItXzzcrVpRNnqEuXj3frFhRNnmGunj1fLNiRdnkGeri1fPNihVlk2eoi1fPNytWlE2eoS5ePd+sWFE2eYa6ePV8s2JF2eQZ6uLV882KFWWTZ6iLV883K1aUTZ6hLl4936xYUTZ5hrp49XyzYkXZ5Bnq4tXzzYoVZZNnqItXzzcrVpRNnqEuXj3frFhRNnmGunj1fLNiRdnkGeri1fPNihVlk2eoi1fPNytWlE2eoS5ePd+sWFE2eYa6ePV8s2IlWfEFYxEvE69tE/GIH/38Z/h5WoEk66h49fxn+HlagSTrqHj1/Gf4eVqBJOuoePX8DAaSh/ixzR9IHuLHNn8geYgf2/yB5CF+bPMHkof4sc0fSB7ixzZ/IHmIH9v8geQhfmzzB5KH+LHNH0ge4sc2fyB5j7I5zy6arLjFop7my8SrVzz6fMQHnY/4oPMRH3Q+4oPOR3zQ+YgPOr+w+PmkPfPuv9KkfMWjzy8rfnn1rv3z/vF1xBE/rvllxW+uIv3J1aQPvLov55k7MKCs+Ce2eHBM/4/JYtr+OO3Zx4NjhnjHK4wQxAcF8UFBfFAQHxTEBwXxQUF8UBAfFMQHBfFBGZF48e+2/JPXtpHFIxjwrgw3arQrhfhTmYT4UY0a7Uoh/lQmIX5Uo0a7Uog/lUmIH9Wo0a7UiMTDkCA+KIgPCuKDgvigID4oiA8K4oOC+KAgPiijEL+YVus3Yc8q0/flPgx6+Mp6kvEqNczf3H42tJ8xiG/egj87b7+8eTfMoE9GGk8yXqWG+/UPVtZKjUF882Eb3Q/t8rvrYQY9fGU9yXiVam7O/tqtSdZKjUH8/OJutfiy6af9EAa7LeRh0MNX1pOMV6mb1tnOWqkxiG8+ZWXt4/fXlpvIw6CHr6wnGa9Sy1p81kqpxd9U1flnP6l2O0XFFt9ivJ/3usV/tm+ya0mxj28ZRry7ffzy6nJ9NNo8WC3fm/l4GPTwlfUk41VqWdvOWqkxiF+ffzZ3vz7pPTPcHz4MGuY8foBVamjG5K7UKMTD8CA+KIgPCuKDgvigID4oiA8K4oOC+KAgPiiIDwrig4L4oCA+KIgPCuKDgvigID4oiA8K4oOCeMtXWY8YxCM+Jotp9eK2/d9qfvG9+dvcRkN48e0Wf9O+E2E+uYxztXTE1+KbN5wtvrrdvC8hBIhvxDdvZT67RnwoGvFf3a6/Qnwc1vv4eueO+FAsr9qj+rNrtngIAOKDgvigID4oiA8K4oOC+KAgPiiIDwrig4L4oCA+KIgPCuKDgvigID4oiA8K4oPyf+FYgP33jXCcAAAAAElFTkSuQmCC" />

We see that the sampling distribution is skewed, with a longer left tail. The most often observed values seem to be around the true value of 0.3, so samples of size 10 seem to work well _on the average_. However, the standard error (the standard deviation of the sampling distribution) is so large that an observed value of -.3 should not come as a huge surprise; in fact, we have observed, with various probability, values in the whole admissible range between -1 and +1.

If we repeat the experiment with 1000 samples of size 100, we get:


```r
hundred = replicate(1000, cor(gibbs(100, rho=.3))[2,1])
hist(hundred)
```

<img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAfgAAAH4CAMAAACR9g9NAAAAyVBMVEUAAAAAADoAAGYAOjoAOmYAOpAAZpAAZrY6AAA6ADo6AGY6OgA6OmY6OpA6ZpA6ZrY6kJA6kNtmAABmADpmAGZmOgBmOpBmZgBmZmZmkJBmkLZmkNtmtpBmtttmtv+QOgCQOjqQOmaQZgCQZjqQZmaQtmaQtpCQttuQ29uQ2/+2ZgC2Zjq2kGa2ttu225C227a22/+2/7a2///T09PbkDrbkGbbtmbbtpDb2//b/7bb/9vb////tmb/tpD/25D/27b//7b//9v///+JwyxnAAAACXBIWXMAAAsSAAALEgHS3X78AAAQSElEQVR4nO2di3ri1hVGZc9MTSdxp3ZmekkbM0l6iZ1eUpckTU0J8P4PVUlHGJA5HAlJe2+x1/q+BEL4hfQvdDlYgmwNLsm0ZwB0QLxTEO8UxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfFOQbxTEO8UxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfFOGbf45e3l43q9ml4+hnsVq2/vOkx0Mcku7tdhssdf/M1Tm8dtcS7i9x5+yLqI36QRb5faGv+/T7Ls9XeraZZlV+v19/ma+3muYPV19vqfuYzV9OJ3k8vvFh/yJ92v59kv8scfv59cbN4k4fllujSXT/YfH/KnhHfAspzC5Z8n+SuU07z443aaq7/l2S/W28cVO2nIOYlf3maFtP8G8Q/Ff+S3pclXkzeV0p/Ck57m5f9+lf9TrdfV83fFP0/hWfzuNIunVc8O2Zvt46qtNGLs4suisyB+MakaLzbWi8nFX9eL24v7xeTyfj0Lkq5CbJE/eZ7lK/8k+2J5W+7Qt8/f2dTnKuflO2Yr/mb9Qz6p2jTzF/5u/XM5B9XjKm204pzEF+vbq8//E8TPS8uz7K68E7SFY7Yf//RJVoi/WodQEP/8/B3x+f+ptvCP2ykUd2rTDFuP/JDw+XG1RhozdvH7R/U/fl04PSr+59vXf//pdiP++e1wUPx21167g3hlXg7nVl9V6g5t6gtJs+zd+ofJS/GHNvXbLfwX1RSqR2rTLDf1YSJs6kXYFz+vNvvFcdrBg7vt2vlS/PPzX4qv/tf+zn7zSJnePoGDOxFqa/yPn5QjteIjmKuncnj2h+JJ+ZjsX8+KV9/mj1Z7gD3xz89/KT6fQjV42zxSDNt+v3Pc8O0ky34Vho7l41qFNGfc4puwKEbqP4xiLZTk/MVXm98b7fkwxvmLX//8MT/gfscKv48D8XAIxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfFOQbxTEO8UxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfFOQbxTEO8UxDsF8U5BvFMQ7xTEOwXxTkmLX0w2Xy0DZ0RS/GoavhFmzneJnBVJ8cv3j3u3Z0R2HO3ZGxbPa3z272N4F7/52tAz3Mcj3imIdwrij3K+wznEH4ODu/PklOHcuQx4EH+MI2v82KtB/FHiw7mxV4N4hawFEK+QtQDij1L98OKBz+rHXg3ij1Ec3K2mN4g/MxoO5x6uEH9eNB3OzV69Rfw50WQ4V/6qx+zleG7s1SBeIWsBxCtkLYB4hawFEK+QtQDiFbIWQLxC1gKIV8haAPEKWQsgXiFrAcQrZC2AeIWsBRCvkLUA4hWyFkC8QtYCiFfIWgDxClkLIF4hawHEK2QtgHiFrAUQr5C1AOIVshZIiD/vb0ZCfFT8eW8OEI940awFEK+QtQDiFbIWQLxC1gKIV8haAPEKWQsgXiFrAcQrZC2AeIWsBRCvkLUA4hWyFkC8QtYCiFfIWgDxClkLIF4hawHEK2QtgHiFrAUQr5C1AOIVshZAvELWAl3Ej/4cXMSfJv54VHvJGoB4xItmLYB4hawFEK+QtQDiFbIWQLxC1gKIV8haAPEKWQsgXiFrAcQrZC2AeIWsBRCvkLUA4hWyFkC8QtYCiFfIWgDxClkLIF4hawHEK2SFOH6GFOLls0J0sYf4IbJCID4G4hEfYTEp94eXjydk1UF8jOQ8rqZ35e38zVPrrD6Ij5Gcx+X7x73bNll9EB+DNR7xEZa37ONdih8mKwTiYyAe8YcpDuqKrf3LXTziz118eUC/eNc+qw/iYzQRv7h+2hvOjegycMTHSIu/vfjmy2KNv2Y450p8MZLPrtZzhnPuxA+SFQLxMRCPeNGsEIiPgXjEH6b6qD478GH9CJYP8THS87ia3pycVQfxMRrM4/Kz+5Oz2iA+Bvt4xItmhUB8DMQjXjQrBOJjIB7xolkhEB8D8YgXzQqB+BiIR7xoVgjEx0A84kWzQiA+BuIRL5oVAvExEI940awQiI+BeMSLZoVAfAzEI140KwTiYyAe8aJZIRAfA/GIF80KgfgYiEe8aFYIxMdAPOJFs0IgPgbiES+aFQLxMRCPeNGsEIiPgXjEi2aFQHwMxCNeNCsE4mMgHvGiWSEQHwPxiBfNCoH4GIhHvGhWCMTHQLxr8cvbq5OzpkF8jM08zrPsIvJdxcmsYRAfY2ceV9MsuzsxaxXEx9jM42JSrPEHfiu8QdYwiI+x2ccf+AXRhlnTID4GR/W+xc/zvfus7dHdCJYP8TGqTX356yOLt2328Ig/A/GraXE4P2+5ox/B8iE+RjWP5Y+MHfj52CZZyyA+Bgd3iBfNCoH4GM9H9Yd/TLJJ1jKIj7H5AKfVZ7V7WdMgPkYlvtVHtftZ0yA+RjWPD7Hfj22QtQziY2w29ezjXYqXzwqB+BiI9y1+Nc3e/BT7ufBE1jKIj7H5rP5mcf3EZ/XuxOfDuVx820HdCJYP8TF21/gZa7w38eWJltlh74tJbKg3guVDfIzkPIY/1R/8Y/0Ilg/xMZLzuNnxHzgAGMHyIT5G8pM71vhzFh+YHfzAPv6mGMHyIT7G7jwynHMqfs4fabyJrzbnB8/GYDh3xuKPwMGdU/EHhnPZhgHnqycQH2NvU58d2KCzxp+z+PXsavOvFzCcO2PxYTvOcM6d+NW0+Ozm8BqfypoG8TF2/zrX9guQRrB8iI/BOXeIP8yRA/4RLB/iY6RPtgz7/yNZyyA+RoOTLZexs29HsHyIj8HJlq7Fc7KlU/HHTrZMZi2D+BgM51yL5/p4p+JXH9t+c/U2axrEx+D6eNfi5bNCID4G4h2LP+3QDvFnIX5x3f4L60ewfIiPgXjEn5Q1DuJjlOLjf3JPZo2D+Bgc1SNeNNsb2XEQH2H84gez1yGqXUoDED9EVLuUBiB+iKh2KQ1A/BBR7VIagPghotqlNADxQ0S1S2kA4oeIapfSAMQPET2KdmMBxItHtRsLIF48qt1YAPHiUe3GAogXj2o3FkC8eFS7sQDixaPajQUQLx7VbiyAePGodmMBxItHtRsLIF48qt1YAPHiUe3GAogXj2o3FkC8eFS7sQDixaPajQUQLx7VbiyAePGodmMBxItHtRsLIF48qt1YAPHiUe3GAogXj2o3FkC8eFS7sQDixaPajQUQLx7VbiyAePGodmMBxItHtRsLIF48qt1YAPHiUe3GAogXj2o3FkC8eFS7sQDixaPajQUQLx7VbiyAePGodmMBxItHtRsLIF48qt1YAPHiUe3GAogXj2o3FkC8eFS7sQDixaPajQUQLx7VbiyAePGodmMBxItHtRsLIF48qt1YAPHiUe3GAogXj2o3FkjPxmIS+2kyE4uA+NNIzsZqelfezt+8+EVCE4uA+NNIzsbmF4cP/PKwiUVA/GmwxotHtRsLpGej+gFS9vF9RbUbC3BULx7VbixwymyY+pENxJ9Go4O7Ymv/chfPGn9aVLuxQBPx5QH94l37rASIP40m4hfXTwzn+otqNxZIi7+9+ObLYo2/ZjjXT1S7sUCD2VhNs6v1XHE4d/ovxCM+yhiGcxbtdYgKtZYA8eJRodYSIF48KtRaAsSLR4VaS4B48ahQawkQLx4Vai0B4sWjQq0lQLx4VKi1BIgXjwq1lgDx4lGh1hIgXjwq1FoCxItHjyPUKeKtRYU6Rby1qFCniLcWFeoU8daiQp0i3lpUqFPEW4sKdYp4a1GhThFvLSrUKeKtRYU6Rby1qFCniLcWFeoU8daiQp0i3lpUqFPEW4sKdYp4a1GhThFvLSrUKeKtRYU6Rby1qFCniLcWFeoU8daiQp0i3lpUqFPEW4sKdYp4a1GhThFvLSrUKeKtRYU6Rby1qFCniLcWFeoU8daiQp0i3lpUqFPEW4sKdYp4a1GhThFvLSrUKeKtRYU6Rby1qFCnRsQnvh5ER4FOtLdOU5UrZWtTGqzH0UV76zRVuVK2NqXBehxdtLdOU5UrZWtTGqzH0UV76zRVuVK2NqXBehxdtLdOU5UrZWtTGqzH0UV76zRVuVK2NqXBehxdtLdOU5UrZWtTGqzH0UV76zRVuVK2NqXBehxdtLdOU5UrZWtTGqzH0UV76zRVuVK2NqXBehxdtLdOU5UrZWtTGqzH0UV76zRVuVK2NqXBehxdtLdOU5UrZWtTGqzH0UV76zRVuVK2NqXBehxdtLdOU5UrZWtTGqzH0UV76zRVuVK2NqXBehxdtLdOU5UrZWtTGqzH0UV76zRVuVK2NqXBehxdtLdOU5UrZWtTGqzH0UWlfqIK8WOK9lY44scV7a1wOfEdzqM1qUAn2kFWF3ldsh0W16QCnWgHWV3kdckivo9oB1ld5HXJIr6PaAdZXeR1ySK+j2gHWV3kdckivo9oB1ld5HXJIr6PaAdZXeR1ySK+j2gHWe3lLSblSPvy8YTsznNPX1yTCnSiLQpPCkk9YTW9K2/nb54S2aE+ojGpQCfa4yf5yWcv3z/u3e4abiMeBqdf8UfWeBgx6bfJ8rZ8Ox3Yx8OIEfvDP9gC8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfFOQbxTxL56HAannZCBRPf5Oh2yRAd4IbHXGUOPo4si3mkU8U6jiHcaRbzTKOKdRvkAxymIdwrinYJ4pyDeKYh3CuKdgninIN4piHfK0OKXt1l1ffX2Xvvser142+pq3W20+EKPu9Oi86zlNcK7M7y5vLx1dJa1fNltdDXNLu4bpgYWXyz+7Gr/Xvts4aBVF9vo8rP79eKXTdvYixbvtVZzvLeIs1Zvt53oQ6s3TD3a+GsMBhZffI9GWFm399pn1w8XfzkxOi8qadPl/ny2muPd6OLTD20EbqOrjy3epfvRnS8tSTOw+MX1U7nS7d5rn1233dTvv1irl92Ptlrjd6Krj9+02tRvo+X3UJwWXVx/ZWZTX2x5wlxt77XPrtuK34uupjcnRheTxj3WorObdvv4bbTYL7Va63eik7vybdCI81/jl7dtvPezscjvtRNfa6fNvunEisexj28rfidarAZtqM3naYcHs/I89xZvuF5edfkbO+KLzezmqP6m9VH9TqKd+G20rfedaOud094Mt1vj91919WWLhd151Qc7m/pqkFloO3UcH5SfNI7PQ2Hda3WA/fyqebbVPn5vhk8ax3d81fxe41Evn9w5BfFOQbxTEO8UxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfFOQbxTEO8UxDsF8U5BvFMQ7xSP4qMnbr48QbLlKZMjAvE7IP68Wbz9bXHGdeE//6e44qw4/3p5m73+cLf49MPlY3WacnhEe24HwqX4yU1x3cJGfPiv9UN+k92VF2A8hEsUwiPaczsQLsVXxvduiiuR8g17eV3CZ/fFhUnVI9pzOxCI37lZP9xVF6QUV7NUj2jP7UAg/sAaH75ggDX+3Niozrfos8uN+M0+vlzNd/f62nM7EI7FF5cn/vr9s/jVtDyqfxsO54vrFsMj2nM7EB7FwxrxbkG8UxDvFMQ7BfFOQbxTEO8UxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfFO+T+M/fRcqxNSHwAAAABJRU5ErkJggg==" />

Again, the samples seem good on the average, but now they have more promise for the individual estimates as well, as these do not stray so strongly from the true value. In practice, we will only draw one sample, and we will never know our actual error but, by planning the sample size, we will know what risk we have taken in what is essentially a game of fortune. If we are rich enough to afford a sample of 1000, we will barely observe any correlations outside of the range 0.25 to 0.35. 

Let us do an alternative display of the distributions. Instead of histograms, we will plot the _empirical cumulative distribution functions (ECDF)_. These show, on the vertical axis, the probability of observing a value smaller than or equal than the argument on the horizontal axis. Graphs of this type are less popular than histograms but are in fact much more convenient. Observe how much easier it is to compare two (or more) distributions. We could have plotted the two histograms on top of each other but the plot would be very busy.


```r
plot(ecdf(ten), main='ECDF')
plot(ecdf(hundred), col=2, add=T)
abline(v=.3, lty=3)
```

<img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAfgAAAH4CAMAAACR9g9NAAAAh1BMVEUAAAAAADoAAGYAOjoAOpAAZrY6AAA6ADo6AGY6OpA6kLY6kNtmAABmADpmAGZmOjpmOpBmZmZmZrZmkNtmtttmtv+QOgCQOjqQOmaQZjqQtpCQ2/+zs7O2ZgC2Zma2/7a2///bkDrbtmbb25Db/9vb///fU2v/tmb/25D/27b//7b//9v///8T3p6MAAAACXBIWXMAAAsSAAALEgHS3X78AAAQhklEQVR4nO2da0Pjyg2GvXuA7hbO9rawp+XQLm1JaOL///saJzZx4rE9F2lGGr3PlwSC7FEeJF8Se5oWmKQpPQBQBog3CsQbBeKNAvFGgXijQLxRIN4oEG8UiDcKxBsF4o0C8UaBeKNAvFEg3igQbxSINwrEGwXijQLxRoF4o0C8USDeKBBvFKvidw9Nx6fntv3fnw6Pfxt+9cv3tt0/HV9sHkuPkhGIf787PrsdftXcQ3zF7B5u3o5PDpL/+Na+Hv4Fdg+ff7btv5vPP/dP3bO6MS/+/a57sv/79/Ykvn1pHiG+Xvq+fvO2PbT24VdH3a+d+L77VwzEQ7wprlv9j+9vaPUWwM5d6QEUYjh2e2y3rsM5iK+Vs3jnCRyIB5UC8UaBeKNAvFEg3igQbxSINwrEGwXijQLxRoF4o0C8USDeKBBvFIg3CsQbBeKNAvFGgXijQLxRIN4oEG8UiDdKivgGSIZRfEIs4AbiOVCQOsRzoCB1iDcKxBslWXx/VyjH9aOGxStIPVX8/ul0069tfyOBkNh6UZB6qvjdt58XjyGxoCCoeKMkb+P7e0dgGz9GQerYq+dAQeoQbxQq8aOdu+FTgN87Dj/jMeBxs9lcPYbFD+/7+iOReOJY5QSkvrkkeo1en7mNA5JeZotVjnfqCaqHVYUaH+KSXmaLNUFKhfdEGB8ik15mi7VAsvUE7QRn7vpbQDoO5A2L90k91XtMfx+HJ73cdqfu7mdegfgl0rwnWm8pWv3u1+foWLukeE+33mIbX4ok7xQDgHgOVlNPOmCPDb1cTtLLbLHKWUs9xXts5PWCkl5mi62c8t4hvgTRBU/nHeJZWEldgHeIZ4FHPKV3iC9AZKcn9Q7xBZDgHeJZWE49Sjyxd4hnYTH1qE5P7R3i8xPhnep03XiRSS+zxdZMuHh67RDPw1LqoZ2e5LM4x2KTXmaLVc5C6oHeeay3EJ+bMO9s2iE+N4H1zjSK9UVDfBTzqUN81cymHtrp04cyu+ykl9lia0VMwUN8XsQUPMSzMJd6YKcnGEnswiE+ilnxQQuB+GoIEc/rHeJzEtTpmd8+iOdgJnVBBQ/xLKSL5/YO8TkJEc83Cq8VQDwhIZt4iFeJO3VJnR7iWUgXTzSQ6DVAPB0BnZ6/4CE+H6IKHuJZcKYuquAhnoVU8WQDiV4HxJPhv4nPUfAQnw1Z3iGeBUfqAQVPOZLYtUB8FC7x3rEQXxW+4jN5h/hceIrP5R3iWYhv9dneNIjnIFp8toKH+Ex47tTne88gPg/SCh7iWZimLq3gIZ6FSPEZCx7i8+C3ic/5jkF8FsQVPMSzMEldXMFDPAvXqXt1+qwFD/FZkFfwEJ8FeQUP8SxMWn1EDDPJ4t/vmttX13yDEH/GQ3zmgk8Wv//x3L7eHvx/fQuOtYOPeP5RhKxvdTjdvPGv9xfzx3vHmsFjpz53waPiWbhKXWDBk2zj77GNvyJYfPaCx159DjzEZxhF0BohnoJV8fkLnkz8aOeuGYgflXYCW32JtwoVz8Fl6qs79SXeKYjnR2LBk+zVd2Cvfh6JBZ9+HP/0eHzc3uA4/sxVq1/5Y5Xih506nLkbEyaecSDRa0XFE1Cl+Hb3gG38CsviCx32Yq+eg4BWX+p0B8RzcJH64mF8sdNcEM/OcsHnGkXgiiE+HYi3w2WrX/pDiK8KX/EFP8iCeHaWxOcbReCqIT4diLeDZ6sv+ZUFiOdgnPrCYXzJdwjiuZHZ6SGeHYg3xEWrn/8riK8NT/H8A5kH4pmZ37cr+zVkiGdGaMFDPAuj1CHeEj7iC19wAvHMzIvPOYrg1UN8KnPiS19hBvEcrLf60t4hngUP8XkGMg/EMwPxNpk5f1O800M8C+fUpXqHeBZWxecayDwQz4tTvICCh3hm3OJzj8IBxHPwkbp7307COwPxHJzFL79cEIhnRewmHuJ5EdvpIZ6FxVYvouAhnoVl8RkHMg/Es+IQL6PgIZ4Vx9GcEO8Qz8KQuqvgsw5kHojnAOKNMxEv557eEM/JVHyJUTiBeA761Cf7dmLqHeJ5GMRf/1rQWwLxjEzEFxmFG4hnBOKt4W71kjo9xLPgFC/KO8QzcrVTL+v9gHg+JBc8xLNwSv1CvDDvEM+CS3yRgcwD8XxAvFHG4qV1eohnYdrqxb0ZEM/BRLy4gk8X/373uH9qmum0c5bFHxkfxst7L1LFdxMOvjwe/H/FhINXiO70yeJ3337ufzxjitFLjqmL7vTprf5Q7tv7tt3eRsRWy0R8qYHMk75z93KcYnTqXWK2WaldPEtsDZzFC+z0EM/CVauX+E5QiR/t3DUD8aPSTpf6xoZ44tgKkN3pIZ4N2QVPcebu2NY/Tw7jZeabh2Or//hB5BtBceauYzs9Zysy3zxcii84kHkIztxdPIbE1k3l4lHxM3zs1Mvs9Onb+N0DtvETGvEFj716FkbihRY8xHPxIb7oKOaBeCYg3iIfrV7uiWuI5+AsvvBA5oF4Hk5Hc2LrHeK5kF7wEM9C00oveIhnYRBfehwLQDwPnXjJBQ/xTBzFlx7EEhDPwbHViy54iGeh6Y7mZOfvJ357/ATukXTRVSO+03uJ354ul9g/hamXnTgv4ju9j/jdnz++Y/HP6afu0YuumWYj3Tu28Sx04kuPYQUv8aea3/8WUu+mxW820gves+Lf727bl0/PpIuuGfkF793qt6H79KbFN/KTR8VzUIt4bOPDULCJ9zqc++vHjzic80LBJh4ncDhQUPA4ZcvBRkHqOIHDAMTbpHHOGi+MkFbvuD4uYdH10lRT8buH4LM364uul4rETy9+T190tTQVtfqXe/pF10rTOGaNl4dnq8c23ptGxfkb7NWTA/EKsmegaaaTh0vE51x91K6dWfHTycNF4ineMQ9B6qIr5fSV+tKjWAfiiYF4DdnTo2UT7yX+ob8bNQ7nVuk+j61GPNOiq6TLuZpWz7ToGmkgPjFWKUfvaPUJsUrpC14DEE/I0Ok1pA7xhBwzhngF2dPSfIhXAMTTcUoY4g2LV5A6xJPRd3qIV5A9Kao6PcTTAfEEsQppRuIVpA7xVPTpQryG7AlpxuIVQCP+/Yvjo3pj4vtHK+IXvqVhSnxzIV5B6skVv3s4KEfFfyRrRnyn/uY/1sWfC95Kqz/yfuf6Op4p8cMTLd6xV0/DlXgFqUM8BY1d8aPrrJqB+FEpY5QqWr2Kf3siRplCvCHxzUS8gtSTxb/fzV1loyB7GsbezYjfP53ui7S9mVxcpyB7GjR2+vRTtv1OneMieivip51eA6j4ZMZ5bqa/EgrBuXrj2/jGqHieWD1cnq6w0+qZYvVwmSXEJ8aq4arg0eoTY9XgLngFqUN8Eo3WTg/xSVx/EAXxqbFKuE4RrT41VgeTT54hPjVWB5MM0epTY1UwLXiIT41VwXzBK0gd4uOBePpYDUy/VKio00N8PNP8ID45Vj6ubxGj1SfHyseVHcQnx8rHkZ2mozmIj8N5uYgm7xAfhzO3zfLLsoD4KCCeKVY47usC0erTY4XjTg3i02NlM3MhMFp9eqxsZrxDfHqsaFYLXgMQH85MYhBPECuadfEKUof4YObu8QLxBLGSmcsLrZ4gVjIQn7ZorczezQutniBWLPN3cdtAPEGsVBZu3qer00N8GAs5QTxFrFCW7tY5Fq8gdYgPYPEurRBPESuTxYzQ6iliRbJ8W2aIp4gVybJ3tHqKWIkEFLyC1CHel5X77yvr9BDvy9q8CxBPEiuO1fk20OpJYsWxmgzEk8RKY32CHbR6klhheHiHeJJYWXhMqHXpXUHqEO+BRyYQTxMrCp8Z9LR1eohfx2vmRIiniRWEn3e0eppYOfjNlHpV8ApSh/hlPGfIVdfp08W/3zWfnqudd853ZmR74rt55/ZP95WK954R216rPwl/ua1UvOffXZ+3U5A6RcUfeP3lS33i5y+euEZfp0/fxu8e7ruH1+lUk/rFe/+lRfE8sRLwrvepeAWpQ/wsAd4Nix/t3DUD8aMSQMj4FXZ6VPwcIaOHeLLY8iSJV5A6xZm7CuePD9tQWRTfH8e325u34FjBBI1d3deuOmjO3NV2rj5sx1Sjd1S8k7ChT8UrSJ3gzF1t2/jgI1Gb4nliCxJ+/sFkq2eKLUeEd4iniy1H+Kgd3hWkDvGXRJxohnjC2GJEDFplp4f4S2IKHuIJYwsR84miy7uC1CF+RNQnyRBPGVuCyG8Q6Oz0EP9B5BdHlG7iIX4g9gtDTu8KUof4ntjRQjxpbG6ivyGotdND/InosWr1DvEniMUrSB3i24RGD/HUsVlJuAJA7SYe4o16h/gU77O7dgpSh/iUYUI8dWw2ki7xU9zpjYtPvLJTsXfb4lMv6J0VLz91w+LTL+Se7/TCU+8wLD55CZo7vV3xBPdtgHj6WGZo7tcxL15w6gNGxVMsZOFgTnDqAxbFE92eR3WnNyie7K5MEM8QywfdzbgWxMtM/QJj4glvwrZ0vlZi6lfYEk947z3N5+k7LIknveeicu+WxNPeanNRvLTUHZgRT3yL1eVOLyt1J0bEk99ZV3unNyKe/obKEM8TSwrHjbSXxYtJfR4D4jnun75yMCcl9QWqF89y33ztB/Ft9eKZpkvQ77168SxLXS14CamvULV4rulRVgu+fOqr1Cyea1acCrbwVYuH9yWqFc83C5aH99L/8x7UKp5x8jOIT1s0H7yT3tXR6asTzz/TYR3eKxOfYXpLr4JHq89LDu1eBQ/x2cgzm20l2/eOKsTnmsG4Iu/p4otOMZp53mpv7wZafYkJB5szXKtw4bl97zAgPu8UoyUnpq+pz7faKr5cJQWUuw6St/E5phgt09rPbEK1G2j1TLEXG/JSvgfCix3iA/76moQ107D5oPRIOKASP9q5G8z93uH/2B4fD/FFHg96nY+lxsP+KKbiq0JB6hDPgYLUdZ+5A9HoOo4HZOg6c6cFBamj4jlQkLqKM3eAHuzVGwXiOVCQOsRzoCB1iDcKxBsF4jlQkDqneCAZPvGs5PgKbw2riF0DxCtfBcQbXQXEG10FxBtdBcQbXQXEG11FdeIBLxBvFIg3CsQbBeKNAvFGgXijQLxRIN4oEG8UgeJ3D01/1c5r47yQg24F52dsq2DK4cD7l59X6wpBnvjumq3X2+PTl0feFYxWxbUKphwObPv/p8gk5Invrs48/TPvfzzzruD8jG0VTDkc/qE+/eM08sgk5Il///rW7n7t3q7jVXv0BXNewfkZ2yqYcjiu5GQ7Mgl54rvLcnsvf3jmqJjzCs7P2FbBlENHLz4yCVniX5rm9uo/mH4bmbXij/Bs52ur+KttFv2blnUbf4RVfDXb+P3Tfb+X2jWx/W/kXs4rOD9jWwVTDh297cgk5Invj0u7tA7HwJ8YGvF5BczH8Yw5tCfx8UkIFA9yAPFGgXijQLxRIN4oEG8UiDcKxBsF4o0C8UaBeKNAvFEg3igQbxSINwrEGwXijQLxRoF4o0C8USDeKBBvFIg/8cL0DXuxQPyJ3bd/TedQrRmI73lt7ksPISsQ39Nd1moJiO95+YupTTzE97x//S/XvStkAvFHuhvJOCZKrxiINwrEGwXijQLxRoF4o0C8USDeKBBvFIg3CsQbBeKNAvFGgXijQLxRIN4oEG8UiDcKxBvl/yA6Q/e7LSCpAAAAAElFTkSuQmCC" />

The two curves cross approximately at the true value of 0.3. The smaller the standard deviation, the steeper the curve. Note how an observed value of -.3 is compatible with samples of 10 (black curve) but barely with samples of 100 (red curve).

Placing the observed value of a statistic in the distribution expected under some hypothesis is an instance of statistical testing of hypotheses. In our case, the observed statistic was -.3, and the expected distribution given a true value of 0.3 was obtained by simulation, or sampling. Sometimes we know the theoretical distribution of the statistic under the _null hypothesis_ (typically, the hypothesis that the true value of the statistic is 0, hence the name). Thus, the distribution of a certain function of the correlation coefficient, $r$, namely $\frac{1}{2}\ln\left(\frac{1+r}{1-r}\right)$, is normal, and the standard deviation depends only on the sample size, being $\frac{1}{\sqrt{n-3}}$. However, knowing the distribution of a statistic under the nulll hypothesis is a luxury that we not always can afford. Consider, for example, the hypotheses that:

* the correlation of a particular item with the sum score is significantly lower (or higher) than expected under the Rasch model
* the assumption of unidimensionality of the test is probably violated
* women who have the same overall level of verbal aggression as men tend to give positive responses to certain questions about verbal aggression less frequently. 

Let us tackle the second and the third of these. To test whether the assumption of unidimensionality is met, we are going to perform a crude factor analysis. For those unfamiliar, factor analysis and the more straightforward [principal component analysis](https://en.wikipedia.org/wiki/Principal_component_analysis) are statistical methods that investigate the inherent dimensionality of a data set. We are going to compute the eigenvalues of the correlation matrix of the items. If the test is unidimensional, there will be one large eigenvalue while all the others must be much smaller, so a viable test statistic is the ratio of the largest eigenvalue to the second largest. 

If we want to do factor analysis of a binary matrix, the appropriate correlation coefficiant is the [tetrachoric](https://en.wikipedia.org/wiki/Polychoric_correlation) one. It can be quite time consuming to compute, especially if we need to do it many times, so I have programmed the fast approximation proposed by Bonett & Price (reference in the Wikipedia article):


```r
tetra = function (d) {
  n = nrow(d)
  x = crossprod(d,d)
  y = diag(x)
  m = -sweep(x, 1, y, "-")
  o = (x + .5) * (n - x - m - t(m) + .5) / (m + .5) / t(m + .5)
  y = y / n
  w = pmin(y, 1 - y)
  p = (1 - abs(outer(y, y , "-")) / 5 - (0.5 - outer(w, w, pmin))^2) / 2 
  cos(pi / (1 + o^p))
}
```

We are going to use simulated data, so we need several more functions. The following one-liner simulates data from the Rasch model, given the item parameters, `beta`, and the person parameters, `theta`:


```r
simRasch = function (theta, beta) {0+(outer(theta,beta,"-") > rlogis(length(theta)*length(beta)))}
```

For item parameters, we can use 20 numbers evenly spaced between -1.5 and 1.5:


```r
beta = seq(-1.5, 1.5, length=20)
```

For person parameters, we already have our `gibbs` function. We are going to generate bivariate abilities with varying degree of correlation, and have the odd-numbered items measure the first ability and the even-numbered item the second ability. First, let us try a high correlation of .95, such that the test is almost unidimensional:


```r
z = gibbs(999, r=.95)
u = cbind(
  simRasch(z[,1], beta[c(T,F)]),
  simRasch(z[,2], beta[c(F,T)])
)
```

As mentioned in the beginning, the user of RaschSampler must supply a function that returns the statistic of interest when applied to the original data matrix or to any of the simulated matrices. The following one computes the matrix of tetrachoric correlations, performs the eigendecomposition and returns just the vector of eigenvalues, sorted in descending order:


```r
eigTetra = function(m) {eigen(tetra(m))$values}
```

Load the library, define some options, and save them in an object, `ctr`:


```r
library(RaschSampler)
ctr = rsctrl(burn_in = 10, 
             n_eff = 500, 
             step = 10, 
             seed = 123, 
             tfixed = FALSE
)
```

We are going to sample 500 matrices (`n_eff`). To avoid autocorrelation, we will use each tenth sample, as specified with the `step` parameter, which means that the number of generated samples is actually 5000. We have a burn-in period of 10 samples (actually, 100, because `step` applies here as well). `seed` is the seed for the random number generator; read the help screen if you must know what `tfixed` does.

Now, call the `rsampler` function with the observed data matrix, `u`, and the control parameters as inputs. The output is a list of 501 matrices: the observed one in position 1, and the 500 generated matrices following. 


```r
rso = rsampler(u, ctr)
```

Next, use the `rstats` function; the first argument is the list of matrices we generated, and the second is our user-defined function, `eigTetra`. The result is a list of vectors of eigenvalues. I then use `sapply` to compute the ratio of the largest eigenvalue to the second-largest:
 

```r
tet = rstats(rso, eigTetra)
out = sapply(tet, function(x) x[1]/x[2])
```

Now we only need to place the statistic for the observed table in this distribution. I have written a small function to do this graphically:



```r
rplot = function(x, label="") {
  epv = mean(x>x[1])
  label = paste(label,format(epv,3))
  plot(ecdf(x), main=label)
  abline(v=x[1], lty=3)
  abline(h=1-epv, lty=3)
}

rplot(out)
```

<img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAfgAAAH4CAMAAACR9g9NAAAApVBMVEUAAAAAADoAAGYAOjoAOmYAOpAAZpAAZrY6AAA6ADo6AGY6Ojo6OpA6ZmY6ZpA6ZrY6kLY6kNtmAABmADpmAGZmOgBmOpBmZjpmZmZmZrZmkNtmtv+QOgCQOjqQOmaQZgCQZjqQZmaQttuQ2/+zs7O2ZgC2Zjq2Zma2kDq22/+2/7a2///bkDrbkGbb25Db/9vb////tmb/25D/27b//7b//9v////vyIJ0AAAACXBIWXMAAAsSAAALEgHS3X78AAAOrklEQVR4nO2di3rjthFG6e26Vrfuxc52e7E3Ses4bWq3tbSS3v/RKlKkLpZkg8IAmMGc830J5aUBijqeHyAlis0SXNKUfgJQBsQ7BfFOQbxTEO8UxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfFOQbxTEO8UxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFC/iFz82zR9eXj+eTq5W///2p+bijy/b5eJfk+b3L9vfG5ar9c31U8GdkMSL+MdmxdX+48XP3WJ+2/58s1lu1r9artdfvpTdESmciJ9NPvzy7fbD0+7jxX3z29brtLl6Wdx/eBqW89t2/cen4fe2y8uXb7cXD6X3RQYn4qdd5a6lDY8Xf//HdC3+1yvhFw/b5c1em2G5Fv+hkqx3I76L8LtXj6fbqG/uhuW0+d2k+fjL5vc2v/+fSdNc3BXeEykQ303aPv559XO/nHb+2+h/Jf7nfg5QBW7EH0b98LCjX9dH+yryW+H7UT8MBYV2QRgn4o9N7pa9+Nl6Ive0Wa7G8sUPzd3ryd10NaNv/yAK74oQTsRvD8lWwreHdp34lcwuwoflev3O7+0dzjG5s0V/EqYTv3MCZxjjL/62s2yP71eTu6MncNp/rwIv4uEViHcK4p2CeKcg3imIdwrinYJ4pyDeKYh3CuKdgninIN4piHcK4p2CeKcg3imIdwrinYJ4pyDeKYh3CuKdEiO+Ac0kFB/RFlKDeCsIv5yItwLiQQLEOyVa/GzSzRGPXB6MeFGURf3ifv1NANPD7/lCvCjKxM8/P+0tx7SFglDxToke4/tvAWOMT42yqE/UFg4IeTnfPRMb3B3iLRFwDn77u1Grt+xM7oZ3AX5qWf3MMuFyJfrVsglcCokXbgsH7L2cfWUPJb5ehrzrdry70auTtYUDhpdz933V0e+2HnZ33upkbeEEx1X3yxHeEW+Go7U9qB6jvO8uavXmMP7YgTziJTk700/1F7V62Z66O/VN3YgXRNb6UiLq59+d+Kbu9ajDfzL/7WsX6C9afJK2sI9gqQ89Rq1O1hZ6tsfnktaXiFeO8MC+23PU6mRtoSOdd8RrJqF3xCtmMN6fnRPuPGp1srawrffhR+Heo1YnawuvvYt3H7U6WVv3JNaOeKUc8U7U18/RqTziqyfZIdzeRqJWJ2vrmBzWl4hXx0nvRH21vH2iDvG1kvIE7ZGtRa1O1tYheb0jXgvvWifqaySg1hFfIRkjfrPJqNXJ2vqigHfEKyBMO1FfHWHljvjKKBDz3WajVidr64dC3hFfmmDvRH1dBNc74quiTM4vEV+YQgP8EvFlGeOdqK+HUTN6xNdDuaBHfFHKaUd8UUaJJ+qrYVzQI74WSo7wiC9IUe+IL8ZY70R9JSDeJ2WDHvGlKDuzWyK+EGd4J+prAPE+KR70iC9Dee+IL8I53ol6+5xV8Ii3j4KkR3wBNHhHfAHOE0/UmwfxPlGR9IjPjoKTN93TiFqdrG3FnOtdW9TPJs3V87H7DSL+KGfXuzLxi68Py+erlf/rl9FtXaIj6OPFt/eNf77Zu398cFuXKPFOxWfm/IJXFvXtGH/DGB9MPeLTtK0WLUmP+MxUJ35ncjdc/Kti/5QR8cIQ9ZZBvFP0JKHErL6FWX0Q9Yhf3N91y+klx/EBRIhXFvXDpI4zd0HUI56KH4Oio53oMX5+yxgfTE3i07StkyjvyqI+Uds6QbxPFAU94nOCeKfEeSfqrRJZ8Ii3iqqkR3w+EO+TWO9EvVEQ7xRVQY/4bOga4RGfi/iPIRL1JokveMRbRFvQIz4PCj9vjvgMiHgn6s0hU++It4bCnF8iPgMqvSM+PULiiXprCBU84o2hM+kRnxzEO0XKO1FvC7GCR7wpdB7ELxGfGLXeEZ8WQe9EvSUE6x3xhlAb9IhPC+KdIumdqDcE4p2iN+kRnxTE+0R0bkfU2wHxPlF8MIf4lCDeKbLiiXozyBY84s2gOekRnw7VQzzi0yEsnqi3gnDBI94KqpMe8cnQPcQjPhnS4ol6I0gXPOJtoDzpEZ8KxDtF3DtRbwL5gtcmfja5W9w3zeFt5xCvOemjxbc3HHy8W/m/5oaDO+i9Zm4gVvz889Pi6wO3GH1FAu/aon5V7tOb5XJ6dUbbaklR79rELx+7nTz0jvjSz+JNmNWnQL93xKcgScGri/o1O5O7ptE/p01Kmt1XKl64rWVs/NkjXhwT3iXO3HX7+eHgMN63+ATdZu0u6Mxdy/TwnK1T8akKXpn4YVLHmbseGyM8FS+OF/HL+S1j/C7JvCuL+kRt7ZKs3hGvGiNBj3hpEO9ZfJqes3aH+JEg3qd4M0mPeFkQH9nWKCm9E/V6SXrWDvF6sRP0iBcF8dFtTZLWO1GvlgrFT7tduhPtuj4sJX2Q+On6conF/Tj1Vl4CKUx5DxE//7L5jMU/D991P7vr6kgsnjFeK4kLvoT4dc0vvh9T7+7E20r6wIqfTa6WjxcPol3XRpXi2wneyDm9T/Ep+8/aHRUfTI3iGePfx1jSBx3O/XXzI4dzJ6lQPCdwQkjunVO2OqlTfIqu68Ja0iNeiErFT09dHxfRdV2k917kcO529Nmb97uuigwFX0T84cXv8V1XhbmkD4z6xxv5rmsi6cdr0xAY9Yzxb5LDO4dz+shS74jXh72gDztXf9bUzpF4i95DxR+5D0Fs1/WQR3z+qEf8O+QpeMRrw2TSB4m/7Q9TOZw7SrXiE3VdC7lO3nA4p4xcBY94XdgMesTHYvAs/RrER5HRO1GviYz1jnhNWA16xEdi1jvi48gonqhXRM6kR7wi7A7xiI8C8dJtjZDTO1Gvh6wFj3g9GE56IfGzT0feqjf6iozAsPdo8W98SsPqSxJM3oLXFvXz25VylxWf+Y05beJb9Zf/9Su+9LM4F5ExfjY59nE8s69JGLa9M6s/m9zi9UV9irYGyF3wSsXvXGfVNJmnPUWwvotU/JkgPklb9eT3ri3qZ5NTV9kgXnaLWbt7d2uL+/X3Ik0vDy6uQ7xmok/Z9pO6IxfRW35Z3sW6dyr+TPKLVxb1b3wxUs3iCyS9NvFp2mrH/BCP+PMw7x3xZ1Gi4Il6BSA+VVvl2E96xJ+D/akd4s+iiHiivjyIT9ZWNxUkPeLPAfHJ2qqmzNyOqC9NoQ+WIb4wlXygEPFjQXxk11Yp5Z2oL0ypekd8WeoIesSPBvGxXduk3NSOqC9KuYJHfFEqCXrEjwXx0V3bpJx4or4kBef0iC9JLQdziB8J4uO7NklB70R9QUoWPOILUk/SI34U9XhH/BiKFjxRX4yyn71BfDEq+dDVGsSHU5N3xI+grHeivhClgx7xZWhKixcG8YFU5h3xgZT3TtQXobh3xJehvHhhEB9Gbd4RH4aCgifqS4B4ua4tUX5OLw7iQ6jPO+KD0OCdqM+PioJHfH5UiBcG8e9To3fEv4+SKT1Rnxkt78ciPi9avEsTLX42aS4e6r3vXKXa48W3951b3N8gPjnKon4t/PGqUvF6vGsT399p8vlXn2oUr8i7NNFj/Pz2pl08H95qsoLXq17vzOrfQlXBK4v6RG11oMm7VvE7k7vhyFfLK3Y2dezFCaj4k1Ty53sCxJ9CW25pi/rZpHt5qrt/vDbv2sT3x/HL6eXL6LaqUaZdHJkzdxWeq6/cOxV/An0Fryzql/PbKsd4xCfrWjX6vEuD+KMgPl3XmtHonahPj7ZD+A7Ep0eleGEQf4gH74g/gk7vRH1qdHpHfGpcBD3iD0F8wOpkbQui1TtRnxat3hGfGLXihUH8Pl68I34fxTM7oj4h6j5otwPi06HZuzSI31DNhSBBIH5Au3eiPg3avSM+Ddq1i4P4Dm/aEd+hPuZbiHpxTHhHvDg2vEuDeJfaEW+n3Il6Sex4R7wcTWPIuzSOxbv27li8Ne9EvQzGtCNeCHPepXEnvnftXLs/8YNue96J+hiaPUo/m1EgPoId49a8S+NJvM1KT4Qf8VYjfoCoPw/r3hF/Hsaty+NNfOnnoQYn4ivQTtSPpPVdgXfEj8T8pC4RjsSXfia6qFv8xnkF3on68CdQVbEjPnTzdXmXplbxdt+Fy0Sl4iv0TtSHbLou5x2If3e7tdV6EuoTj/YgosXrusVofUP7BmVRr+GGg1vJ9WpXJ770LUb3PderXRyrFd/LbY6TcsuVED3GZ7vF6J7PXu+B6oqlK4t6gbZhsvYr2WGJVyc+UNzRQPciPQFS4ncmd4OXn1qkl6v+X/37cu/fWQYuzVR8zcN3ENVFvXujgWgTr+vMHYRi9TgeIrF+5s4PyqKeis+FMvH5ztyBKApm9VACxFtBW9SnaQsHIB4kQLxTEG8FQ1EPmkknPn+3GrdqdFcRb3KjiC+/VaO7iniTG0V8+a0a3VXEm9wo4stv1eiuchLGKYh3CuKdgninIN4piHcK4p2CeKcg3imId4qw+OdmuPRi+yg9i/vm4qF7NL9tDq/4Sb3RjLv63H22pru2KXJXhcU/3h0+Ss9qW+srvNrrvZ6vMm80664ul0K7Kit+8fXh4FF6ttdzto9mn7IU33ajOXe13fB3D8P2Y3ZVVnx3nd3d/qP0zK5/6FN3dv0yvDD5NppzV1f0ZR67q7LiZ7956Atg+yg9s8ld9zqsUzCX+M1Gc+7qpuCjdzXBrD77OL/9489a8XubyjbOD5er66r4juzi51+G1yDnGP+ljPjHm377qsb49s9x8f3T3qMMPA6pu7i/yTmr344v2XZ1M6bE7qr8cfxqxtP+Ja4f5WE1vfqw/vvPeBy/3WjWXV0PafG7ypk7pyDeKYh3CuKdgninIN4piHcK4p2CeKcg3imIdwrinYJ4pyDeKYh3CuKdgninIN4piHcK4p2CeKcg3imIX/OY7wP5OkD8mvnnfx/eQ7VmEN/z3NyUfgpZQXxPe82rJxDf8/gXV0M84ntm1//L+8UWpUF8R/uNMkdulF4xiHcK4p2CeKcg3imIdwrinYJ4pyDeKYh3CuKdgninIN4piHcK4p2CeKcg3imIdwrinfJ/Z4q7Rx3bUgwAAAAASUVORK5CYII=" />


The plot shows the empirical cumulative distribution function of the statistic. The vertical line is drawn at the value of the statistic for the observed data set, and the horizontal line helps place it in the distribution. We see that the statistic is not particularly extreme. 

Now, repeat the same, except that we use a low correlation of .35 between the two abilities: 


```r
z = gibbs(999, r=.35)
u = cbind(
  simRasch(z[,1], beta[c(T,F)]),
  simRasch(z[,2], beta[c(F,T)])
)
rso = rsampler(u, ctr)
tet = rstats(rso, eigTetra)
out = sapply(tet, function(x) x[1]/x[2])
rplot(out)
```

<img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAfgAAAH4CAMAAACR9g9NAAAAnFBMVEUAAAAAADoAAGYAOjoAOmYAOpAAZpAAZrY6AAA6ADo6AGY6OmY6OpA6ZrY6kLY6kNtmAABmADpmAGZmOgBmOpBmZjpmZmZmZrZmkNtmtv+QOgCQOjqQOmaQZjqQkDqQ29uQ2/+zs7O2ZgC2Zjq2Zma22/+2/7a2/9u2///bkDrbkGbb25Db/9vb////tmb/25D/27b//7b//9v////cp3sLAAAACXBIWXMAAAsSAAALEgHS3X78AAANTUlEQVR4nO3dDXfayBmGYTmNa5qmxZvtl8m2S9hua9oaAvr//61IQiBAYKSZ0byj577P2YP3GI0VX6NPG5PlJFkWewUoTsCLBrxowIsGvGjAiwa8aMCLBrxowIsGvGjAiwa8aMCLBrxowIsGvGjAiwa8aMCLBrxowIsGvGjAiwa8aGrw279n2R/eqo+//5g9/PHt5DH7/Hp8TuO5i+wl4kqHSA1+ke16Kj/cPBcfT88eH98Ozzk+d5UBn3bryYdfvz9/eC0+XmVPb9vZh9f6cT15fPv+/DCvn3N87noCfOKtyi35YV59/Nsd+MO8fqzgy4lQPufw3N2s+Afwabfa7dLrA3a1a89e6sf8P7sN++Hl8JzDc3f/LYFPuyZ8cTL38c+7j+vHX6pj/Tl88Qh84jV39WX1x4vjLv9sV//zrNwh7M8IR5MYfPPkbv38sTiBe60fV7sz+u0sezk7ufs38GNof4m22cFuZ9WuvX6sjvW7SXF5OceuPvn2N2UK+PLGzd/yvPmYffy19QYO8DSSgBcNeNGAFw140YAXDXjRgBcNeNGAFw140YAXDXjRgBcNeNGAFw140YAXDXjRgBcNeNGAFw140VzgM7JcQHiHZSl0FuCZIRECXjQL8BQh4EVzhi/+8k9Wvny4+7Jdn0j+coXfzqoXCK8e3zov2/mJ5C9X+M2X15PHLstSxCxs8RQh52P8/q+BcYxPLAtn9cD76t07sY2nOn062LJ0V2fQd9yDPz7X6dPHGid39U8BvhXt/p/HgI876LP/z+589ATvsiy7hh71/KnbcXmnT/tZFviuXYPmGD/mem3gl6M4fTrYsnStfjv2lnGcPn24jG+7kGdXHyAv6OVATp/Oi1t3097Ldn0ieVLPfezqNz/M2z+Bp/88qecc49PKn7sJeGbInXl0Bz6lPLqbgKf78ukOfEKNDp4Zcl8+3YFPJ68bvAl4uivgNfN5LZfbgGeG3JFnd+ATybe7CXh6N18/mmmM6PTpYMvSad7dTcAzQ97NNzvwiTROeHov7zt64NNopPDMkHfyf2oHfBIFcDcBT7cL4Q58Ao0WnhlyO+BFC+FuAp5uB7xmQfb0JuCZITcDXrTxwtPNgrgDb7/xwjNDbga8aOOFp5sBr1mYk3oT8MyQWwEvWhh3E/B0o0AbPPDWGzM8M+RGwIsWyN0EPF0v1AYPvPFGDc8MuV4od+CNN2p4ulqwPT3wths3PDPkasBrFs7dBDxdC3jRRg7PDLlWOHfgTTdyeLoW8KKNHJ4Zci3L8OtJ9rRse79B4J0LeFLvDL/9Os+XTzv/z2+dl6V3sgxfvG/8cnry/vF3L0vvFNDdxBbPDLmSZfjiGD/lGB8m0/BhlqU87CEeeMMlAd84ucvqPK2DbEnAuywLfHsh3U3AU3u24Xdn9UUuZ/XUnmn47eylfFw9ch3vO9Pw9Umdy5074NszDe9ji6fWgp7Uux/jN88c48NkHN7DssyQ1oK6A2+38cNTa8BrFvYQbwKeGdIW8KKFdTcBT20BL5oAPDOkLeBFE4CntoAXTQCeGdJS4Mt44K2mAE8tAS9aYHcT8MyQloDXLPSe3gQ8XQa8aKHdTcAzQy4DXjQJeLoMeM2Cn9uZgGeGXAS8aBrwdFFwd+BtpgHPDLkIeM3CH+JNwNN5wIsmAs8MOS+8O/AmE4Gn84DXbIBDvAl4ZshZwIs2gLsJeDoLeM2G2NObgGeGnAa8aEO4m4Cn04AXTQaeGXIa8JoNcm5nAp5OAl40HXhmyEmDuANvLx14Ogl40XTgmSEnAa/ZMCf17vDryct2lmWXbzuHZ78SgS/ecHDxsvP/zBsO+ikR+M2X1+3XOW8x6q9h3N139bvNfTXN89VTj2W7PlGiVODzRbmml+549isZ+CDLCicEzwxplhh84+Quq/O0DmIlBu95Wd0GupoD3lrJwK8n5Zp+uLiM5xjfq4Hcvdy5K1pd3rMFvk+pwNcndS537qhRKvA+tnhqlAp8vnnmGO+zZOA9LAt8IyV4agS8aErwzJBGwGs21I07E/B0DHjRpOCZIceGcgfeWFLwdAx40aTgmSHHgBfNGPyqXJ8Xr0NTW6bgV9XLJbazbvTA98gS/OZPh9+x+OflT917D93jieNvsPs3HONtZQy+2ua3P3XZ3vHs02Dud27x68lTvniYex2aWrIGX5zgdTynZ1ffJ2vwYbd44A8Zg+cYP1DDndvddTn318P/hrmcozpb8MFv4DBD6oZzN3HLFvg6c/AhhqbLgBfNHPzq2uvjHIbu8cSxN+C53Z2Xc8+d7968P3SPJ449e/CXL353H5ouGtD9zl39Yup/aLrIHPz118A7DN3jiWPPHHyQof18kTE15CHeBDxVWYPvd2oHfOeGdL8XvuV9CFyH7vHEkQe8aHLwVGUOvrqYC3c5R1XW4AMN7eeLjCngRZODp7JBL+OBt5MePDOkDHjRBnU3AU9lwIumB88MKQNeND14KgNes2Gv5kzAM0OKgBdtWHcT8FSUJPz6U8uP6oHv0sB7emf4G7+lwa6+S6nB7+R35G5bPPB5gvAF/eN/2dW7NrC7n2P8etL263jAdylJeMdlmSE58LKlCt94nVVW13+tBEsV3vOyeinCM0OGv5pzh19Prr3KBvgOJQe/nVV/F2n1ePHiOjw7lBx8fVLX8iJ64Ds0+NmwhS2eGZIg/I0/jAR8h9KDD7OsXMBrNvwdLwvwzBDgVdOEp+EP8cDbSBOeGQK8aprwBLxoEX5xxQI8MwR40SL8ppoFeAJeNFF4ZgjwoonCyxfjZQjAG0gVXn6GAC9ajBecWYCXD3jRVOHlZwjwoqnCywe8ZlH+jIQFePUZArxosvDqxXAH3kCy8OozBHjRZOHVA140WXjxGRLlag74+OnCixfFHfj46cJrz5A4e3rgoycMrx3wosVxNwEvPUMibfDAx04ZXjrgRYvkbgJeeoYAr1msPb0JeOWAF00aXnmGxHIHPnLS8MqlC7+eZA9z3neub8nCF+87t51NneCFZ0i0cztn+Ap88QR8r9KF37/T5PI3n9jV9yiau/sxfvM8LR6Wl281Cfz7JQzvYVnhGQK8aOnDN07usrr+a6VSxO+ThS1eN3F43RmSMvx6Uq487x/fp4hHRE/X8fnq8a3zsvLFPBXyc+eOe/W9ShnexxYvO0NiXvt4uHPHMb5vScOHWVYj4EVTh5edIcBrFvXGtgV41YDXLO6PsizAi86QuD/CBD5awGsW+XcWgI8V8KIzJPIvKQEfqdi/nWYBXjLgRYv966gW4CVnCPDAx/n6Tp8Otuz4A1404DVnSOyTeuAjBbxosd2Bj1P0Dd4EvOAMAd71iyRadHcT8IIBr1n8Pb0JeL0ZArzzF0mz+O4m4PUCXjMDe3oT8HIzBHj3L5JicV9CU6+E06eDLTvmTLgDP3wm3E3AR/8mDJsJd+CHD3jNbOzpgR884L18keQy4g780AGvmY2L+Bz4gTPjbgLewvdhmOy4Az9owGuWAS+ZJXcT8Da+E+EzxA78kAGvmSl34IfK1AE+twFv5psRMGvuwA9TBrximT134AfInnruAZ63GL1dZnFzz93hecPBm2VW3Z3heYvRW5llt7HFj7C9tF1392M8bzHa0t7asLuFs3qT3xenspNir0178eENf3P6ljW3+NgrcyVf8I2Tu+Nc//ZN+DGvHnOjj2zxIUrgXxQfPoXv0gizcOeOIsR1vGgW7twxQyJkYYsHPkIW7txRhAyc1VOMLMAzQyIEvGgW4ClCwItmAZ4ZEqGQ8GS5cPAe8v3lPY9ne7iUj9OWvhXJDQd8sPFsDwd8sPFsDwd8sPFsDwd8sPFsDwd8sPFsD5cyPMUKeNGAFw140YAXDXjRgBcNeNGAFw140SLBF6/ErF6hs3nOLl+j4zDeMmt98Ue3VocxvKzecTgva5cfX9/Uf/XiwG9+mOfr383z6l+wfPI3Xr54cV67fP3pdb9SXlbvOJyXtStaVtPcYfXiwK+KlS2/CcVrMYtvjK/xtl/nzmtXVq2Un9U7DOdr7da//7GEd1i9eMf4Yivd/RM+v+0/8jNe+Uo/H5tVtSF5W71qOE9rt/36c7Wrd1i9aPDb2bR4KF6E6+U7ux+v2OF72K7Wk4dyDE+rVw/nae2W0/0x3mH1YsFvnksnb5tUPV6ZjyOp5x1SYxDntdut1DbVLX492f/rPR1ED+OVeTmF8ngKchju7KOeLctfmy8menLH+KNTsYd2P6s/jlfs/LY/OUod96BeVu84nJe1y/PD5ZzD6sWBr+bsSzFZvVwoN8bbffjgfhAtB/G5evvhvKxdXsG7rR537kQDXjTgRQNeNOBFA1404EUDXjTgRQNeNOBFA1404EUDXjTgRQNeNOBFA1404EUDXjTgRQNeNOCrFj5+vT+lgK/afPnX5Xuojjng9y2z6ftPGlHA79v/XQWZgN+3+IvUIR74fevP//P1tzTSCPiy4kWILW+UPuKAFw140YAXDXjRgBcNeNGAFw140YAXDXjRgBcNeNGAFw140YAXDXjRgBcNeNH+D651wTpLa4KqAAAAAElFTkSuQmCC" />


For the second example, let us consider differential item functioning (DIF). In __dexter__, we have included a popular data set on verbal aggression. 316 subjects (243 women and 73 men) responded to a 24-item questionnaire with questions about four frustrating life situations, two of which are caused by others ('A bus fails to stop for me', 'I miss a train because a clerk gave me faulty information'), while in the other two the self is to blame ('The grocery store closes just as I am about to enter', 'The operator disconnects me when I had used up my last 10 cents for a call'). There are also three types of verbally aggressive behavior: curse, scold, and shout, and two modes: want to do or actually do. Each item can be answered with 'yes', 'perhaps', or 'no'. Hence, the design is: In situation [1|2|3|4], I would [certainly|probably|not] [want to|actually] [curse|scold|shout]. We will analyze a dichotomized version with responses 'yes' and 'perhaps' combined. We know that, whatever their total score on verbal aggressiveness, women tend to score higher than men on a subscore comprising the 'want to' items, and lower on a subscore comprising the 'actually do' items. In other words, women tend to 'do' less than they 'want to'. 


```r
library(dexter)
gender = verbAggrData$gender
d = as.matrix(verbAggrData[,-(1:2)])
doItems = grep('Do', names(verbAggrData)[-(1:2)])
d[d>1] = 1             # dichotomize
rso = rsampler(d, ctr) # sample matrices
```

For a statistical test based on the Rasch Sampler, we use a very simple statistic as suggested by @Ponocny2001 as Example 4: we simply count the positive responses given by women to any of the 'Do' items. 

```r
T4 = function(x, grp, fgr, itm){sum(x[grp==fgr, itm])}
out = rstats(rso, T4, grp=gender, fgr='Female', itm=doItems)
rplot(unlist(out))
```

<img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAfgAAAH4CAMAAACR9g9NAAAAolBMVEUAAAAAADoAAGYAOjoAOmYAOpAAZpAAZrY6AAA6ADo6AGY6OmY6OpA6ZrY6kLY6kNtmAABmADpmAGZmOgBmOpBmZjpmZmZmZrZmkNtmtv+QOgCQOjqQOmaQZgCQZjqQkDqQtpCQ29uQ2/+zs7O2ZgC2Zjq2Zma22/+2/7a2/9u2///bkDrbkGbb25Db/9vb////tmb/25D/27b//7b//9v////Mcv1oAAAACXBIWXMAAAsSAAALEgHS3X78AAAONElEQVR4nO2dC3fiyBFG5ck49k4msfeRB0xe6yXZxE5iWND//2tB3WALwxhEd1Nfq+49Z4+8p9UqpFv9UCMNTQsuaaw/ANiAeKcg3imIdwrinYJ4pyDeKYh3CuKdgninIN4piHcK4p2CeKcg3imIdwrinYJ4pyDeKYh3CuKdgninIN4piHcK4p3iTfzqr03z2+f49y/fN1e/e97ZNp8fX/fp7TtrJoYfugTexM+aNTfhz+V99/fdm+3188s+r/vOG8TXzeL2w8+/3H947P6eNzfPq+mHx+12cXv9/Mv91cN2n9d9F7eIr5x5aMlXD/HvX6+FXz1st1F8SISwz8u+66z4G+LrZr7u0rcDduzam8l22/5n3bCvJi/7vOy7/u8J8XXTF99N5j7+fv33dvuPONa/Fd9tEV85/a4+sP179trlv+nqf5yGDmEzIxwNzsT3J3eL+4/dBO5xu52vZ/SraTN5M7n7N+LHwOYWbbkWu5rGrn27jWP9Oin2b+fo6qtnsyjTiQ8LN39q2/62+fjzwQUcxMNIQLxTEO8UxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfFOQbxTEO8UxDsF8U5BvFMQ7xTEOwXxTkG8UxDvlBTxDShTUHxCXSiNgngyxADEO0VBPBiAeKcki+/+5Z8mvD48vO7QHSEfqeJX0/iC8Pz6eXDdwTtCPlLFL7973NkOqQuGKLR4MCB5jN/8a2CM8ZWhMKtHfC6OrsT2dk0qLlYXhtI5P2EN/nX/pOJXepO77bcAP3Ws/5/tBbbb6336NpP4lLp0Deew27xP/dbttUJScZ66iD+HQ9+0MsaPnAMD+gDncf+k4mJ14T0GN+9Dx0gqfrmNP3QjT1dfgpfGnuY9vcWvpndn1x26IwyfxH31QEnFHctvHw4X4DMz/caefHEZ46shW2OPR0sqzlOXDDmJrN4RXw/5pIejJRUXqwsHyOkd8XWQ1Xk8YlJxnrpkyDHy9vLxkEnFeeoi/hhZp3WbQyYVF6sLO4y0xcNRGOMhE4h3ioJ4eI/8vXw8bFJxsbqwpcC8Lh43qThPXTLkHQrcycXjJhXnqYv4dxhzi4f3YIyHnCiIJ0MMQLwwhXr5eOyk4mJ1oS03r4sHTyouVhfacndy8eBJxXnqkiGHGX2LR/xXYIyH7CDeKQriyRADEO8UBfFgAOI1KTmhjwGSivPUJUP2KHoLHyMkFeepi/g9ii7axQhJxcXqesdHi4d9GOOhDIh3ioJ4MADxchQf3mOUpOI8dcmQPuUn9DFMUnGeuojvU/4WPoZJKi5W1zGOWjzswBgPBUG8UxTEgwGId4qCeDLEAMQ7RUE8bLnMnVwMlVRcrK5PLrR2E2MlFeepS4ZsuNBqbYyVVJynLuI3eGvxsIUxHkqjIJ4MMSBZ/OK2uXk69HuDiJcmVfzqy0P7dLP2//l5cF0wJFV897vxT3c7vx9/cl3occF5XYyXVJynxZMhl72TiwGTitswxt8xxidzybWbGDCpuFhdd9TX4svU9UdtY/yW3uRu8G+gkiEGKLR4xBugIB4MyDGr70iZ1YMByffx00nYzq+5j6+KHCt3/e2QuoN3hHwotHjvXPpOLgZNKl6zvGeMT+PiazcxalJxnrrOM+Tiq7UxalJxnrqId9rivVPnGF+mLpRGQTwZYgDinaIgHgxAvFMUxJMhBiDeKQriwQDEO0VBPBliAOJNMVmtjZGTiovVdYLN9zMxdFJxsbpOsPlGNoZOKs5T12+GOG/xfsUzxsOlQbxTFMSTIQYg3ikK4sEAxDtFQTwZYgDinaIgHgxAvFMUxJMhBiDeKQriwQDEO0VBPBliAOKdoiAeDEC8FXYP38TwScV56rrMEMPH7WL8pOI8df2KN3SvIN4ltHivMMaTIRYg3ikK4sEAxDtFQTwZYgDinaIgHgxAvFMUxJMhBiDeKQriwQDEO0VBPBliAOKdkix+cTtZTZtm/2fn8ClNqvjuBwdnk7X/z/zgYFWkil9+97j68sBPjA7C+BmM+BmSitesm/v8rm3nN2fUHbrjSLB+6ip+iKTijlk4j33v7nyejPVzlvFDJBUXqztq7K23GuLNL8KlEfCeTXxvctcM7crsr4JDFFo8GIB4p2RYuQvd+oe923jGeGlyrNx1zPfXbBGvTIaVu53tkLpgiEKLBwOSx/jlPWN8jSjM6hFvgIJ4MADxTlEQT4YYgHinKIgHAxDvFAXxZIgBiHeKgngwAPEXRuGxqw4F8RpX4jJIPGjZgfjLovBkdfwgJxXPw6edZD20T0S0nyZ+Hl+XWE2HqZc4PzlEvJ8ifvnDyzMW/9z/1v3sQ5+xI+SDMd4pJ4mPbX715yHtHZ/anNbiF7c37ezqIeuhwZRTu/r50Dk9Xb02Ci0e8QYwxjvllNu5P778b5nbOTBAYQGHDDFAYckW8QYoLOCAAYh3ypCu/sD7cQmHPmNHyMdpt3P3g1dvjh/6jB0hH6eJ33/5Pf3QYMppXf3sLv+hwZQTu3rG+LGhMKtHvAEK4r2g8tRV4JS1+rOmdoh/i8xzloETxR/4HYLUQ5+xY91I/KPVLyD+YghZbzXEe0HJ+0ni7zd9VKnbOTBAYVZPhhiAeKcoiAcDEO8UBfFkiAGId4qCeDAA8U5REE+GGIB4pyiIBwMQ7xQF8Q4yROqLuQDiL4HWV/EBBfHjR+vhm0Ae8YtPB76qVzpNY9Sst+ni33lKg67+FTnv6S1+eb9Wntbi1a6JCzJ09cv76//S1ddGljF+cXvocTzEK6MwqydDDEC8U3KJ771n1QjetcJbFFo8GKAgngwxIFn84vZrb9kgPiA65qWKX03jv4s0v957uU7yfC+O6mwnecl2M6k78BK94uleHtWZrkKLl7soOZG03mZZq2eMfxdN7xKzejAA8U5REE+GGIB4pyiIBwMQ7xQF8WSIAYh3ioJ4MADxTlEQT4YYgHinKIgHAxDvFAXxZIgBiC+I6FfxAQXxY0X14ZsA4suh+rhdQEG85pVJR9d6i/iiCHuXEA8GIN4pCuLJEAMQ7xQF8WAA4p2iIJ4MMQDxTlEQDwYgvgzKi3YBBfHil+gcpJfpA4gvgvQXcwEF8SNE3HqL+FKoe5cQL36JxgninaIgHgxAvFMUxJMhBiDeKQriwQDEO0VBPBliAOKdoiB+ZMiv1gYQnxv972cCCuIruEwD0P9GNoD43NRgvdUQPzKq8I54ryiIJ0MMQLxTFMSDAcniF7fN1QO/O1cdqeK7351bTe+SxJMhBqSKj8JnN4ivjBwtfs3Trz7R1VdF8hi/vL/rNk/7PzWJeGUUZvVkiAGIz0kdq7WBXOJ7k7umku+n8lPTWSu0+NFQU8YriK/iQp1CNdbbPCt3/H78lnq857qPb+fXz4PrgiF5Vu5Yq68OhRZPhhiQYeWOMb5GFGb1YADinaIgngwxAPGZqOgWPqAgfgzUtGgXQHwealqmDyiIr+dqfZ26rLeIz0Zl3iXEgwGId4qCeDLEAMQ7RUE8GIB4pyiIJ0MMQLxTFMSDAYhPp7ZFu4CC+AovW5/qlukDiE+mui/mAgriK6dC6y3ic1CjdwnxFV62+kG8UxTEgwGId4qCeDLEAMQ7RUF8xVR5JxdAfAp1rt0EFMRXeunaWldrA4hPoVbrrYb4iqnWO+K9oiC+zgypt7EHEH8mFQ/vAQXxVVLxhD6A+DOp2nqrIb7O61e3d8R7RUF8dVTe2AOIH0bnvPbhPaAgvqKL2PSx/jBJIH4QI7HeaoiviOh8BN4RP5AxOA8oiB/JpawLxDtFQXwljKaXDyD+VEYxl39FQbz+5XxZthmPe8SfwHju3l9REC9Nv7GP44wiiH+fMTb2QLL4Mf/E6GgW5g+QKn7MPzg4WukdqeLH/BOjY/Yu0eJVGa/1NsMYP9KfGA3KR+xdYVaveHlH3dgD9uIlr/Goh/dALvG9yd3rLdBPP9W/7c5njFta/GEUP1NW7MWP/xpLorByBwZwH+8UhZU7MsQAhRaPeAMUVu7AAIFZPVigIJ4MMQDxTlEQDwYg3ikK4skQA0qKB2XKib9IUy4fYhQnMTgE4sdxEohXjKAYAvHjOAnEK0ZQDIH4cZwE4hUjKIZgbcUpiHcK4p2CeKcg3imIdwrinYJ4pyDeKYh3yhniF58ee5vwps3yvtl/0SaBfojVtLl6yB6iH2FxG14XKXIS3SunrxeoZIjdSEcZLn4eX6rZbNqndbRO/tPN4COdFmI26V7fyhyiH2H57UP7lD3C67EX3zxsjl0yxG6k4wwWP7v6e5dmm027+M33k/BC5aYJ5WAnxOZlzbwhdiIsPj93hy9yEvPOwWyyOXbJELuRjldO7OpXX35cp1i4dOuMy0YvxOLzX7quPneIXoRNiy91Et1BN8cuGWI30vGqieKf7rq+pXuTtpj425BYuUP0TyIOi6VOYjW92x67ZIjdSMerpolfG1kVb/FFGks/wjcP7fzDY6GTWN6vpZRt8SHEbqTjVdPEP4UHuO8yj127HfEP4Uxyh+hF2DSSMifRdVgvM5SSIXYjHa+a5Xau62NyzlZ3QswmsWPJG2K/xRc5iY2UzbFLhtiNdBz9+/j1sQvcZfcjzJsSKwW9LnFS8j5+E+JNpKOwcucUxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfFOQbxTEO8UxDsF8U5BvFMQ7xTEOwXxTkG8UxDvFMQ7BfGRWeYn3uVBfGT53b/2f0N1zCB+w1NzZ/0RLgriN3QvUnkC8Rtmf3A1xCN+w+Lz/764avKID2z/eQc/IN4piHcK4p2CeKcg3imIdwrinYJ4pyDeKYh3CuKdgninIN4piHcK4p2CeKcg3imId8r/AXUCONPmwQOgAAAAAElFTkSuQmCC" />

Finally, we take a cursory look at the relationship between sample size and the results from the Rasch sampler. With parametric tests, test statistics increase with sample size, and p-values decrease, so null hypotheses are more likely to be rejected, other things equal. The Rasch sampler is a typical exact, nonparametric test. Let us see what will happen when we apply the last statistic to 50, 100, 200, and all 316 cases:


```r
layout(matrix(1:4,2,2,byrow=T))

rso = rsampler(d[1:50,], ctr)
out = rstats(rso, T4, grp=gender[1:50], fgr='Female', itm=doItems)
rplot(unlist(out), label = "50 cases")

rso = rsampler(d[1:100,], ctr)
out = rstats(rso, T4, grp=gender[1:100], fgr='Female', itm=doItems)
rplot(unlist(out), label='100 cases')

rso = rsampler(d[1:200,], ctr)
out = rstats(rso, T4, grp=gender[1:200], fgr='Female', itm=doItems)
rplot(unlist(out), label='200 cases')

rso = rsampler(d, ctr)
out = rstats(rso, T4, grp=gender, fgr='Female', itm=doItems)
rplot(unlist(out), label='All 316 cases')
```

<img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAfgAAAH4CAMAAACR9g9NAAAAulBMVEUAAAAAADoAAGYAOmYAOpAAZmYAZrY6AAA6ADo6AGY6OmY6OpA6Zjo6ZmY6ZpA6ZrY6kNtmAABmADpmAGZmOgBmOjpmOpBmZjpmZmZmZrZmkNtmtttmtv+QOgCQOjqQOmaQZgCQZpCQkLaQtpCQttuQ29uQ2/+zs7O2ZgC2Zjq2Zma2kDq2kJC229u22/+2///bkDrbkGbbtmbbtpDb25Db2//b/9vb////tmb/25D/27b//7b//9v///8xtr3kAAAACXBIWXMAAAsSAAALEgHS3X78AAAaYElEQVR4nO1di5bbthHlrrdSUqddOXHSNNHGTdus5bTN0u5jJa/w/79V4iFREikQGOIxwMw9Pqa0AAa4uMDgQYhsBIMkmtwFYOQBC08ULDxRsPBEwcITBQtPFCw8UbDwRMHCEwULTxQsPFGw8ETBwhMFC08ULDxRsPBEwcITBQtPFCw8UbDwRBFF+G3TNDePYve2efXokayPv102r347uzweg4+xts0qRuFnYf9w+zQsqSOS8o8i/EayFy9vFvvN3bNzqj7+brmSn8xF/f32yQQfY+0f8An/+W3TUb8sqSPS8o8h/P5BFX/brMX2RjXOrpXe/CDEx+Xxsj42XfPtNL75ZC4df9Eevx1jtQ064V/e3Cw74S9LipJ/DOFf3nSe/kdd/Gat/rB4/tSsd188SmewW97ry2rffxPiJL75ZC6mxZ//sesVf1iiE/7nfz0chO9LipN/DOF3b1QTbc+ISOz/+W0jW/DN/X+FjCEDzDchm/Ah/m65EBsZpC7ik+oTJthcOq/yH3TCmzH+vKQCJ/9Ys/quPfctuNXEd8tXf990dP/Rzf3++Ny5qkZ6K/1NnLZ4OZ35ark2l1NXd2zxrXaB2LAf7fEY+ccW/jhmCd3GlVfb//utKrqOqr6JszmB/KY/bY+e42yM++VBVdsiUunB6IU/HeMx8o/i6nUT7Wepcozr/tgx+PxGFn0lPjZ9Q1bfxHFWK92f/nS4nJk7m/tGKPw8KOEHJcXIP0qP/7i8WMd2n5p70S1Abv5kxqwflD+T01nzTRziyybdGZDez1xkjB+H61i0wg/X8Qj5884dUbDwRMHCEwULTxQsPFGw8ETBwhMFC08ULDxRsPBEwcITBQtPFCw8UbDwRMHCEwULTxQsPFGw8ERhFX6rTvStU5UFFWrnbhN+/5M827X78uk8RXGA1Ev13G218vKdPMy5f3dB3scEBoDKVz13q/Bfj7Z6HxMYABO+du7+YzxOrgenNuLcYAUuiLswtL24+1NBRb7XW38aG9YCFhgN9wNb85+i7cd9mko/zunpwnuJ7tvx2lx8T3k9lMd6darK8riLI0dLXVylFqDHZ+gGpx39fP4azNWP5xvRtnMZmtHVhaDg6q06D2MHzDicKVD2B69+6eqvpwCEhEsRHE4L1T52wIzDmYLkfhjJ3XirJIAQ/WSLDrf4ljRemzKw5RxC7n6a6ySAkA671yOP7sEgvBdg5UPGfdqrjycDhEi0I3vVGXWG7b4CC4yKu2dH79MBQsKlCAUg+8LHeNPXvb28TgwIcU6R0N35zOn6ZAFLENH2tSyvLtWcUgNCnFOk6wZJXb2TqTTCgzq7Tg0ICZciM8p19XP6urEACAmXIjOKFR7cz09MAEKcU2BvCcW6+llO3pgAhDinYOFjYXaHZ1ePz1QasPDoTKUBu/pIpsrlXoLwM4e6IoWfP7xrM4CQcClmYu6qpkRXH2Alp+0AQsKlmAngTm2fPmBRwpmayGj+Sk7bAYQIedJ00TbHB2lfS1Gnq8/MPaur3797ahfmpwWWFOVOcCyonrut5B3t7Wr61yTYASpw9dwD9HjsiNnjsaPsMX4mihzjA6HsdfxMFLmOD4Q5wl/+mgQ71wFmFLhi7gWs4+eixHV8KLCrj2QqBveQfgU8uZOY+qlwncJn4x50RAEu58YfBxKmSOkAW85l4x5qt1YbA4Q4Pw4kFkI1fOgGjsjEPb+rz/s4kASt3gJ+FEq2MX7uTbneEChV7fMbxMu5rK4+uqk0KFL4UGDh/UKcU2CvjdLW8SHBwkcyFZZ7+C1hdvXoTI1ZD38zgIVHZ2rMetC9G20SEOKcAntLYFfvF+KcgoXHC3b16EylAQuPzlQasKuPZKpc7iz8LFPlcrffpLn738P0SVPsAN6kqZz7xEGMdlXz2XILquc+cRCjXdf8XhYLquduLfmvT7v7wUNdKyJvQ2LukU5uA4VXj3C+eIAzep0HgBU4LfdYZ/Z5HY/O1IXhSD/YmCP85K9JsLeEGeVLxx2Xq3dLUbHwk6bK5c6uPpOpNJgSfv/QubG7wSsZsrx0L+FhBAVM3INjQvit2qHaXtJ0/DVJ6HvSoZW3m8PEPTzswr/82Xz59ZxmlhfrBjtO31u0BaLiHh5Trl7Rv6Du/GuSwEjt6jFxD47JyZ28JTF8+U7t45wGTe6HkN0Xj1fjTNjCXhuT5SPJ3drj3WyVS16DJnfbGO9rCylAYzzIFAwxn6wDm9X72kIK0KweYAqIqM9UclzHr0C2sLcEt3V8Nu6x7s9o4xMhV3av3GyVLbzIzj2fqw9lCyl4r94Sshk5deBtCymmCkyTu5nVf+NGfNQW9tqYmtXT5G7G+HckySsQ5W56/NgBM29bSDHV42ly58ldJlNpMEP4zeVuZkXubgo1c1c7d9+Nr2KVExy4wYrIC8LcjfDj/NuFS6vHjinhaXK3Ci+2i6rJC8LclfCjbk1he/eXRONcvI1Lu/BZuUd/5QV8crdbphE+4j0qsN3o3OO/7AT/ci78GcveNEpTylzMG3M6B0DIAYleyJPJ1dsRmztiV++QAvuMJ2aPL5c7Cz/LVLncrSWv/YixDbVzt1HhlxFVzN1GpfqfEVlQPXer8LW/kMeC6rnzGH8Fkbknek0t/g2ciMC4gRN/z87kAwhxToG9JWBczsXapRzkAwhxTsHCQyyxq48OjK4+FVh4dKbSgF19JFPlcmfhZ5kqlzu7+kym0oCFR2cqDdjVRzJVLncWfpapcrlnd/XxdzLY1fuFCHWjwuH1HLOQddvShnjcE23a6bwAIfowwmYd9550vMO1fRaQRPG4p7o/ozMDhJjDCB9+iXsYAamrj8c90e0ZkxkgxBw/2v/0+2qPH1kQkTt+V68PoFR87syG2rnzcm6WqXK5T5ecX0akjNTGPfs6Pj54He8XEi5FZrDwfiHC9aQp9toAb+CE555yQq8zBIQQeCGPBVG4J9270TkCQpx/TYId8A2c0NyT7t3oHAEhBF7IY0Ec7oW4eh7jK+bOGzizTJXLPddyDsUdqpym0gCd8CmnODiETz6861wBIc4pIIwiPuRqmFdEU86206/kdLaAEOcUIEKVuHov4TOIj87VpwS7er+QcCkyA4fweYDP1ScEClefCSx8JFPlcmdXH91UntHd5A0ICZfiNHGGSsgsfKaFnMkcEOKcwsNElkrI7OqT7VeMZg4IERFuVKTct+kzBaUKwl2xLM/VR3isZzGuPgj3rF5elwAQwgcxZnPP6eRNCQAhIR/rmbXhxzyIYanY3F5elwIQIhzHOQdyWFu9DSDu/ff8Xl4h4qzehWGWOV2fezRTl3xOvuf38roYgJADBr8mad6/97/K1Lmu8Hqbxz0n50nu89fx2Vv1FCKu46+7eiTAsoGTBbxX7xci+Hn1NXNPvIGTA/k2cPIj6gYO9tqIuYFTLnfABk5xgNRY9dz9x/jr8Kphn8ix4tpwhTukJi1FCmsuRz1528IuvLd5Fj58ZBZ+dkaz4ga1xcKHN8fCxwMLP9cWCx/eHKJ6YmAFC08ULDxRsPBEwcITBQtPFCw8UbDwRBFE+JdvnoTYNDePh/+dI0/ElnH3D02zcjB8FneyFL7YqDt1bdMsXDiepGnlTb6VcxqTkWtlnqRxrSeDEMJvm9snsb17Pv5zjKxPuUzFbWVVrycNn8SdtOuP7UI2rK1bUc7SdB/2PzvUy3lGjpV5msaxng4IIPz+r/Kgyu71c1eAdmXIukR++XYpO9BE3FY249WU4dO4U3ZhkHX7vezxkxzP0nT/f3j0SSMjOlbmeeGc6umIIK5enVDaNl1La4fvarseeSv7qPWYh4wrXdj3q2nDfdxpuwBspL/umlO7duB4kkZ1SJd6OUvkWpknaVzrySCY8J2n2X355NDg+sjy23Y1FVeidWjJfdxpuyC0slY7wz69Vxam6/BePV5m5FqZZxm51ZNBOOFX/eDkGnklHHq8HBO+fpw2fBJ30q43lMmV7rvOQ+9KCy6PbbqP8atePr+MXOvJIJjw0tOsXSaVZ5Ebe8dUvXjjZvgs7oRdf2zUfL71mjjrNLt7/dl9Vr8QzpV5mpFjPRnwOp4oWHiiYOGJgoUnChaeKFh4omDhiYKFJwoWnihYeKJg4YmChScKFp4oWHiiYOGJgoUnChaeKFh4omDhiQKJ8JuFOrtMEnm4IxFebL6nqnsm7liE330R/GdPxSALdyTC73/622uX0+A1Ig93HMLvH1aidfodQH3IxB2H8IzkYOGJgoUnChaeKFh4omDhiYKFJwoWnihYeKJg4YmChScKFp4oWHiiYOGJgoUnChaeKFh4omDhiYKFJwoWnihYeKJg4YmChScKFp4oWHiiYOGJgoUnChaeKFh4omDhiYKFJwoWnihYeKJg4YmChScKFp4owgv/adnc/CjE7m3z6vF4cUYff7tsXv12dnkcWt0Gf3swCLulfHrRtllvG/UW60+6tGL/cPskxMvb5uYHH2sp6iC48J/f3Iv25vHlzWK/uXs2F+fUffzdciU/mYv6++3TpdX9Aw7hW/UK56Pwn7vySck/v21u5auzF2Jz+5uzsTR1EMXVmxrY3jyai/zjTrf7j8vjZX1stuabSmninxvouMvmdGm1Df++cAj2D797szjt8fJPUpubZSf8bnl8lz2iOogi/MYIf7wI1Y6fPzVr+RTHrtnulvf6str334ShquKfGzCt/cLqbvmHJQbhOxqy+CfCd5o/ipef/yX7/fbmKyMppjqIIfyH5u651eVqz0hI7P/5bSNb7839f4VswDLAfBOy+R7i75YL2YDMRc0c1uLcater/oNC+EM/POnxWkTl8NumE+zYgyUw1EEE4T80msp5j2816d3y1d9lLfyjaZo/ds1DYmW+idPWLqcyX3VOUl9O3dzRaqvdX3Zot744F159UsLjrIPwwrfKrw3GeENFtm/dGf79VhVbJ1LfxOn4JmE+dZf2hO3B6i8PqsryP/V6t5TlUE54THg5xp95PRR1EFz4rhbMkH4+q5fjW9c2u9J/fiOLvRIfm74Rq299Mun69KfDRUccWEXR41VHbpUkB4HVsG2E72b1z3r0xlQHwYXXnms9XMd3n5p70S0+bv5kxqsflC+T/sF8E4f4sv66Wa70fOZyZXcAg/B6sd4NxH2P/6gX3iboM8Y64J07omDhiYKFJwoWnihYeKJg4YmChScKFp4oWHiiYOGJgoUnChaeKFh4omDhiYKFJwoWnihYeKJg4YnCKvzWHKOiiNq524Tf/yTPdO2+fDpPURwg9VI9d1utvHwnD3Hu312Q9zGBAaDyVc/dKvzXo63exwQGwISvnbv/GI+Wq/JrI84NVuCyuAs9DA3/eD26fwbeKSKj4yspK+Jj7AMWGB13BdPi/bhPU+nHOW37vUT37XhtLr4nvZrydJTNtRleHeuvOO7CwnmSe4Aen7MbDKawwVz9eHYRbUMwOYev1NUf+VqXbPW6+jmLtoKFnyJ9jBcwy3Cm5mNadvBy7o2ye4tzSeNA20SEWMfNXWXtwh7Y43evRx5bhIW8m+oCWj7U3FXWEYUX7cheNRp357oXCywwau5Xlu3DWICQcCliwGMHvsox3tHdRRU+R224unkVN2C2EW37wXGgq0x453mdjh0w44i2vTB/flOiq/dRXVTp6p35s/CBcg5nahYCrGgKdfVesQNmHNG2B0IMc+UJ732ipjrhPfxdRa7ey8vrFAEzD2dqBoJMbIsUHo+rz4EwS1l29bNMZWgJgSa2pQkPODNbofA4enxK+I/wNbp6j7iAkHApAsJ7gBe1CR9qfmM1s20W+m0r1hR1unqE3FWGfg0fJvz+3VO7MD8tsKRA0A2sAJUPK3dPlwcTvqO9XU3/miQdYL+GAiVCx/1YhASu3rHVJwNkZifi9vjUCLd5VdIY7793o5OBMkPG3WTny7+SdXxCV+9oKoPwKWb1Cpe/Jsnu7nwxo8DouCdy9YFSZEY96/iQm1dFuXoYqnH1QTevJiZ3ElM/Fa5TeITcAYMNcDk3/jgQv6zzA7acw8g9lat3fBxIIoBnVtANHIGHOxhA4TE9DgQ+p4YJj4k7HBWM8fDlVC1jPIR9Dcu5tK4+uin/vMPuWpYjPBgVCc/reB/Uso5H5+pZeLwo3tXP2SWvxNWDULrws+6PsPB+Ic4pEtTGrFtj7Or9QpxTpCCP1dUnPIQCSwYICZciM2pw9eE3r1j4TKY8MwaOdYW7+nknX9jV+4U4p4hOfuaZpyqEBwJ6k+bufw/TJ02jY+ZpN+BNGhzcZwJ8EKNdYThbnsHVo+E+D+CDGO265veyWFA9d2vJf33a3Q8e6loReRtQcY+weWW1qB7hfPEAZ/Q6DwArMCbuMU4f4V/Hz/4VQ/nrePjsdo7wk78miVsb83+/MiN5Zu59NoldvVuK+MLzBg4U7OrDALvOA0wJv3/oetXd4JUMxb10bxQTBSbKXYVs1Q7V9pKm469JsNeGvXxUucuQlz+bL7+e06z+xbqCMHcdouhfUHf+NQl2TBQYP/cox85MiLwlMXz5Tu3jnAZ27nNWNdOz+t0Xj1fjTNjC3hImy4ece5zzhtYe72YrJvkQDx+B9Xg3U0kafURXPz7O+doKjyCPnQGN8SBT+ACb1fvaCo8gTxwCzeoBpjDCcR2/Atkq29Xj5R4CwJ07N1vxyId5vBhs587NVOnCh7EVGoEeLMd79ZaQzcipA29boRHokYJTJlByP8lzTqaTs/pv3IiP2irc1SPlfswh0gljM8a/Q01+HqbGeNzc57m9yR4/dsDM2xZSTPV45NyjuvowtpCCJ3d+IQaby93M2ly9BTVzVzt3342vYpUTHLjBisgLwtyN8OP824VLq8eOKeFRc5+5sAEKL7YLDORnAiY8Du7xThgr4UfdmsL27i+5xrlgr4OwC4+Se28/2k/Ep6zulpnIh3sRCNhMNu6nGcR09aFsBUWQO7LaUggjwU2lwRzhc72QJ42rtyP3y4ginkUI0OOxd4OYPT4u95i/G2ThZ5mKL3yWMR7PEeM5gBUYBfdMrh7lC3n8ASpw9dxtVKr/GZEF1XO3Cl/7C3ksqJ47j/FXgIB71N8UIN3ACblixmnKIbMA+walLeeC7pWUupyL+2MSvMJj2LmbNBXVBbCrn2kLpak0KE74kGDh/UKcU2CvjUJdfeRfEbHws0zF4x77V0Ts6jOZmswq8rMBMAof+LZ3mcITdPWhDzyU6erDoDjhS1nOxRI+/nlDdvWZTNnzCdXy4TdpHF7PgR3gmzT5uAdzevCDGJt1xfekLcjMPa+rV4cRPvxCUvjquU/1+O6/36d1d8HPMIN7fHruwQEc49UBlMTnzsKfXoeZy8H9mE2wfApazoX/3UJxy7kkt6Snc0j9Qh4crl4jz8uIArb9stbxgVHeOr4QV48d5QkfDvANHIeTpiFrI8bPEsEbOIm5H20maamTy7mkZ8uj/CAVvpzLcq4+0UHTyQ2cpNuWUX6LDN/AybJlG7QKgMKnfyEPGlef8WVE+V19xnEuJEob40OijA2cSA+cKGsDJ9UhFETLuViPGilqORe4EooRHs0YH93UtRxSnT5iVz/LFGlXH6ak8Z4oVZLw6e5MYnH1EZ8lVpCrT3hnEpPwBbr6wAheCezqI5kKfxYhqEH8wsd8ZmQxwifdrsbh6qM+LbQMV99EeWhqCcIX6erDWY4zycHt6ju+5F09LuFT3KiIOJ0/5ABKlfYmTfpdS1tmKR7reRjasPX4dI80jVoBwPvx8Q8jRFddQO/HJzqI0TRRmz5Q+JiP9VQDe3zVBVT4NI80jSt73DEeUuamidzSzzIDpYrG/Tx95CqIOKuHlDul7DFn9XPLn3OYm8538GuS5v37cFdpNfYVXm9xuaeogxnCT6WAuXr/NGBEXMfPd/Xz0k9nAAhxTpFSRAiK2MCJhKgbONgRcwMHO/Bu4CQA8g2cqIi6gYO9NmJu4JTLHbCBUxwgNVY9d/8x3pbEZg2WLLxFR8wd492j5jEKWYvBrBUm/FyzLPy8ZCx8JKMsvA9YeIA1Fh6VURbeB7SFZ9QAFp4oWHiiYOGJgoUnChaeKFh4omDhicJd+FberVoJ8fLNkxCb5ubxMmj/0DR3zxdBh2QbdadrLJn8sLoS1KXq/jpusbssxpMdE58lg0MxNv+PlPVK1LHyjcfUcexGzyrXalTHHBfjBF49fv/zs9g2t09ie/fc/bsI2kqe62GQCesKNZpM3gFdjVvUx2CuWhzNTVlUEYbJYFCMzf9XyjoS9WptDGPePR//XTV6as5u1MS0Z+8p/IdHsf+rPJXSNXvTAU6CJNr1MMiEdX8dT7Z7/Wk1bvHl22XXa8Yttt83o2E6MxlhmAwEzVj/f62sI1GvlW8Yc/datuIJoxKHyrUb1TFP44/S8hFetiJ9HKm9fCWbDpKXQZAJ20jvPJZMeoIrQdtbmdW4xc1CjIXpzLYqcHByCghtRv5/paxjUa+UbyRm11G7XjlptK/cKaN9JViM+givO9Noj9dBiuw1Z9CFjCYz4/K4xa74wyCdbD0aduzwwXr8qUZXyjoadbx8YzEX8ojXpNG+cqeMbnRPGxXjCA/h9flDZfxy7FBB+wfpYAbDigrr+klXitFkQoWOBqlUw4FKhy3GwrRFHSHUGH/aOUfLOhp1vHxjMbU6E0ZPK9duVMe8IkYPD+F3932JL2aLKmgzPpnWyTZjc1xjUQk8GrRRs/5xi+1YmA46JA40q78U3mL5JOpo+cZiygn4YMVzGfWscq1GdcwrYvTgdTxRsPBEwcITBQtPFCw8UbDwRMHCEwULTxQsPFGw8ETBwhMFC08ULDxRsPBEwcITBQtPFCw8UbDwRMHCEwUS4TcLczaUIPJwRyK82HxPVfdM3LEIv/sizInYEpGFOxLh9z/97XWQM/AFIg93HMLvH1aiDfPrh+KQiTsO4RnJwcITBQtPFCw8UbDwRMHCEwULTxQsPFGw8ETBwhMFC08ULDxRsPBEwcITBQtPFP8HrYpy/cyFlFEAAAAASUVORK5CYII=" />

```r
layout(1)
```


As the sample size increases, the overall value of this particular statistic increases, the relative dispersion decreases, and the statistic for the observed data, always very extreme, gets even farther away. However, the p-value remains the same. The reader might want to experiment with some less extreme examples.

# References