X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=src%2Flanguage%2Fstats%2Fcrosstabs.q;h=6adae77b030a674e81035da71ea6dd245652f828;hb=6da9ed01e15953f12bc1ba35fbee53a7a7e46da0;hp=93c28ca7e7e755e999376ca19d0c5cc8e378b61d;hpb=b54f315669badd4f9feec09fe50a8002aea198ec;p=pspp

diff --git a/src/language/stats/crosstabs.q b/src/language/stats/crosstabs.q
index 93c28ca7e7..6adae77b03 100644
--- a/src/language/stats/crosstabs.q
+++ b/src/language/stats/crosstabs.q
@@ -2090,16 +2090,17 @@ display_directional (struct crosstabs_proc *proc, struct pivot_table *pt,
 
 /* Statistical calculations. */
 
-/* Returns the value of the gamma (factorial) function for an integer
+/* Returns the value of the logarithm of gamma (factorial) function for an integer
    argument PT. */
 static double
-gamma_int (double pt)
+log_gamma_int (double pt)
 {
-  double r = 1;
+  double r = 0;
   int i;
 
   for (i = 2; i < pt; i++)
-    r *= i;
+    r += log(i);
+
   return r;
 }
 
@@ -2108,11 +2109,11 @@ gamma_int (double pt)
 static inline double
 Pr (int a, int b, int c, int d)
 {
-  return (gamma_int (a + b + 1.) / gamma_int (a + 1.)
-	  * gamma_int (c + d + 1.) / gamma_int (b + 1.)
-	  * gamma_int (a + c + 1.) / gamma_int (c + 1.)
-	  * gamma_int (b + d + 1.) / gamma_int (d + 1.)
-	  / gamma_int (a + b + c + d + 1.));
+  return exp (log_gamma_int (a + b + 1.) -  log_gamma_int (a + 1.)
+	    + log_gamma_int (c + d + 1.) - log_gamma_int (b + 1.)
+	    + log_gamma_int (a + c + 1.) - log_gamma_int (c + 1.)
+	    + log_gamma_int (b + d + 1.) - log_gamma_int (d + 1.)
+	    - log_gamma_int (a + b + c + d + 1.));
 }
 
 /* Swap the contents of A and B. */
@@ -2130,6 +2131,7 @@ static void
 calc_fisher (int a, int b, int c, int d, double *fisher1, double *fisher2)
 {
   int pt;
+  double pn1;
 
   if (MIN (c, d) < MIN (a, b))
     swap (&a, &c), swap (&b, &d);
@@ -2143,13 +2145,21 @@ calc_fisher (int a, int b, int c, int d, double *fisher1, double *fisher2)
 	swap (&a, &c), swap (&b, &d);
     }
 
-  *fisher1 = 0.;
-  for (pt = 0; pt <= a; pt++)
-    *fisher1 += Pr (a - pt, b + pt, c + pt, d - pt);
+  pn1 = Pr (a, b, c, d);
+  *fisher1 = pn1;
+  for (pt = 1; pt <= a; pt++)
+    {
+      *fisher1 += Pr (a - pt, b + pt, c + pt, d - pt);
+    }
 
   *fisher2 = *fisher1;
+
   for (pt = 1; pt <= b; pt++)
-    *fisher2 += Pr (a + pt, b - pt, c - pt, d + pt);
+    {
+      double p = Pr (a + pt, b - pt, c - pt, d + pt);
+      if (p < pn1)
+	*fisher2 += p;
+    }
 }
 
 /* Calculates chi-squares into CHISQ.  MAT is a matrix with N_COLS
@@ -2234,8 +2244,7 @@ calc_chisq (struct pivot_table *pt,
       }
 
       /* Fisher. */
-      if (f11 < 5. || f12 < 5. || f21 < 5. || f22 < 5.)
-	calc_fisher (f11 + .5, f12 + .5, f21 + .5, f22 + .5, fisher1, fisher2);
+      calc_fisher (f11 + .5, f12 + .5, f21 + .5, f22 + .5, fisher1, fisher2);
     }
 
   /* Calculate Mantel-Haenszel. */