# 短くSNP-HWE検定 with R

```hweExact<-function(g){
n<-sum(g)
nA<-2*g[1]+g[2]
na<-2*g[3]+g[2]
evod<-g[2]%%2
obs<-(g[2]-evod)/2+1
maxAa<-min(nA,na)-evod
Aa<-seq(from=evod,to=maxAa,by=2)
AA<-(nA-Aa)/2
aa<-(na-Aa)/2
pr<-rep(0,length(Aa))
pr<-exp(n*lgamma(2+1)+lgamma(nA+1)+lgamma(na+1)-lgamma(2*n+1)-(AA*lgamma(2+1)+Aa*lgamma(1+1)+aa*lgamma(2+1))+lgamma(n+1)-(lgamma(AA+1)+lgamma(Aa+1)+lgamma(aa+1)))
P<-sum(pr[pr<=pr[obs]])
return(list(Aa=Aa,prob=pr,obsprob=pr[obs],P=P))
}
xx<-hweExact(c(813,182,5))
plot(xx\$Aa,xx\$prob,type="l")
abline(h=xx\$obsprob,col="blue")

xx

\$Aa
[1]   0   2   4   6   8  10  12  14  16  18  20  22  24  26  28  30  32  34  36
[20]  38  40  42  44  46  48  50  52  54  56  58  60  62  64  66  68  70  72  74
[39]  76  78  80  82  84  86  88  90  92  94  96  98 100 102 104 106 108 110 112
[58] 114 116 118 120 122 124 126 128 130 132 134 136 138 140 142 144 146 148 150
[77] 152 154 156 158 160 162 164 166 168 170 172 174 176 178 180 182 184 186 188
[96] 190 192

\$prob
[1] 6.677657e-138 1.159028e-132 3.314239e-128 3.746770e-124 2.242522e-120
[6] 8.252481e-117 2.045840e-113 3.633951e-110 4.835154e-107 4.983558e-104
[11] 4.084682e-101  2.719019e-98  1.495559e-95  6.895953e-93  2.698288e-90
[16]  9.053841e-88  2.628863e-85  6.657912e-83  1.481079e-80  2.911932e-78
[21]  5.088041e-76  7.940417e-74  1.111742e-71  1.402149e-69  1.598872e-67
[26]  1.653952e-65  1.556885e-63  1.337333e-61  1.050987e-59  7.574737e-58
[31]  5.017728e-56  3.061265e-54  1.723328e-52  8.967414e-51  4.320183e-49
[36]  1.929861e-47  8.004694e-46  3.086890e-44  1.108096e-42  3.706790e-41
[41]  1.156729e-39  3.370503e-38  9.178481e-37  2.337838e-35  5.573802e-34
[46]  1.244746e-32  2.605403e-31  5.114243e-30  9.419404e-29  1.628548e-27
[51]  2.644170e-26  4.033142e-25  5.780887e-24  7.788460e-23  9.865114e-22
[56]  1.174928e-20  1.315896e-19  1.385971e-18  1.372797e-17  1.278652e-16
[61]  1.119806e-15  9.219395e-15  7.133969e-14  5.186826e-13  3.542076e-12
[66]  2.270984e-11  1.366320e-10  7.709413e-10  4.076919e-09  2.019095e-08
[71]  9.356731e-08  4.053368e-07  1.639693e-06  6.186375e-06  2.173932e-05
[76]  7.104431e-05  2.155473e-04  6.059695e-04  1.575120e-03  3.776325e-03
[81]  8.327509e-03  1.683765e-02  3.110291e-02  5.227197e-02  7.954073e-02
[86]  1.089705e-01  1.335122e-01  1.451239e-01  1.385839e-01  1.148576e-01
[91]  8.134855e-02  4.824313e-02  2.329631e-02  8.795864e-03  2.434900e-03
[96]  4.393805e-04  3.877168e-05

\$obsprob
[1] 0.04824313

\$P
[1] 0.1457905

```