static void mPower (double *A, int eA, double *V, int *eV, int m, int n) { double *B; int eB, i; if (n == 1) { for (i = 0; i < m * m; i++) V[i] = A[i]; *eV = eA; return; } mPower (A, eA, V, eV, m, n / 2); B = (double *) malloc ((m * m) * sizeof (double)); mMultiply (V, V, B, m); eB = 2 * (*eV); if (B[(m / 2) * m + (m / 2)] > NORM) renormalize (B, m, &eB); if (n % 2 == 0) { for (i = 0; i < m * m; i++) V[i] = B[i]; *eV = eB; } else { mMultiply (A, B, V, m); *eV = eA + eB; } if (V[(m / 2) * m + (m / 2)] > NORM) renormalize (V, m, eV); free (B); }
double K(int n,double d) { int i,j,g,eH,eQ; // Marsaglia's shortcut for p >~ 0.999 double s = d*d*n; if(s>7.24||(s>3.76&&n>99)) return 1-2*exp(-(2.000071+.331/sqrt(n)+1.409/n)*s); int k=(int)(n*d)+1; int m=2*k-1; double h=k-n*d; double *H = (double *)malloc((m * m) * sizeof(double)); double *Q = (double *)malloc((m * m) * sizeof(double)); // Fill H with 0s where there will be 0s and 1s everywhere else for(i=0;i<m;i++) for(j=0;j<m;j++) if(i-j+1<0) H[i*m+j]=0; else H[i*m+j]=1; // Fill edge parts of H for(i=0;i<m;i++) { H[i*m]-=pow(h,i+1); H[(m-1)*m+i]-=pow(h,(m-i)); } // Set bottom left corner H[(m-1)*m]+=(2*h-1>0?pow(2*h-1,m):0); // Fill lower triangle of 1s with 1/(i-j+1)! for(i=0;i<m;i++) for(j=0;j<m;j++) if(i-j+1>0) for(g=1;g<=i-j+1;g++) H[i*m+j]/=g; // Compute pow(10,eQ)*Q := H^n eH=0; mPower(H,eH,Q,&eQ,m,n); // Compute scale factor (n!/n^n), avoiding underflow by modifying eQ // Computed as product[i/n | i <- [1..n]] s=Q[(k-1)*m+k-1]; for(i=1;i<=n;i++) { s=s*i/n; if(s < 1e-140) { s*=1e140; eQ-=140; } } s*=pow(10.,eQ); free(H); free(Q); return s; }
static double DurbinMatrix (int n, double d) { int k, m, i, j, g, eH, eQ; double h, s, *H, *Q; /* OMIT NEXT TWO LINES IF YOU REQUIRE >7 DIGIT ACCURACY IN THE RIGHT TAIL */ #if 0 s = d * d * n; if (s > 7.24 || (s > 3.76 && n > 99)) return 1 - 2 * exp (-(2.000071 + .331 / sqrt (n) + 1.409 / n) * s); #endif k = (int) (n * d) + 1; m = 2 * k - 1; h = k - n * d; H = (double *) malloc ((m * m) * sizeof (double)); Q = (double *) malloc ((m * m) * sizeof (double)); for (i = 0; i < m; i++) for (j = 0; j < m; j++) if (i - j + 1 < 0) H[i * m + j] = 0; else H[i * m + j] = 1; for (i = 0; i < m; i++) { H[i * m] -= pow (h, (double) (i + 1)); H[(m - 1) * m + i] -= pow (h, (double) (m - i)); } H[(m - 1) * m] += (2 * h - 1 > 0 ? pow (2 * h - 1, (double) m) : 0); for (i = 0; i < m; i++) for (j = 0; j < m; j++) if (i - j + 1 > 0) for (g = 1; g <= i - j + 1; g++) H[i * m + j] /= g; eH = 0; mPower (H, eH, Q, &eQ, m, n); s = Q[(k - 1) * m + k - 1]; for (i = 1; i <= n; i++) { s = s * (double) i / n; if (s < INORM) { s *= NORM; eQ -= LOGNORM; } } s *= pow (10., (double) eQ); free (H); free (Q); return s; }
// pow(10, *eV) * V := (pow(10, eA) * A) ^ n // where dim(A) = (m,m) void mPower(double *A,int eA,double *V,int *eV,int m,int n) { double *B; int eB,i; // Base case (n = 1): copy A to V and eA to eV if(n==1) { for(i=0;i<m*m;i++) V[i]=A[i]; *eV=eA; return; } // Recursive step: // pow(10, *eV) * V := (pow(10,eA) * A) ^ floor(n/2)) mPower(A,eA,V,eV,m,n/2); B=(double*)malloc((m*m)*sizeof(double)); // pow(10, eB) * B := (pow(10, *eV) * V) ^ 2 mMultiply(V,V,B,m); eB=2*(*eV); if(n%2==0) { // if original N was even, finish by copying B to V and eB to eV for(i=0;i<m*m;i++) V[i]=B[i]; *eV=eB; } else { // if original N was odd, finish by multiplying: // pow(10, *eV) * V := (pow(10, eA) * A) * (pow(10, eB) * B) mMultiply(A,B,V,m); *eV = eA + eB; } // Finally, if center element of V is too big, move some of its exponent into *eV if (V[(m/2)*m+(m/2)] > 1e140) { for (i=0; i<m*m; i++) V[i] = V[i] * 1e-140; *eV += 140; } free(B); }