packages feed

htestu (empty) → 0.1.0.0

raw patch · 41 files changed

+34512/−0 lines, 41 filesdep +basedep +randomsetup-changed

Dependencies added: base, random

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Nikita Kartashov++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/testu/src/bbattery.c view
@@ -0,0 +1,4389 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           bbattery.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "config.h"+#include "bbattery.h"+#include "smultin.h"+#include "sknuth.h"+#include "smarsa.h"+#include "snpair.h"+#include "svaria.h"+#include "sstring.h"+#include "swalk.h"+#include "scomp.h"+#include "sspectral.h"+#include "swrite.h"+#include "sres.h"+#include "unif01.h"+#include "ufile.h"++#include "gofs.h"+#include "gofw.h"+#include "fdist.h"+#include "fbar.h"+#include "num.h"+#include "chrono.h"++#include <stdio.h>+#include <string.h>+#include <math.h>+#include <time.h>+#include <limits.h>++++#define LEN 120+#define NAMELEN 30+#define NDIM 200                  /* Dimension of extern arrays */+#define THOUSAND 1000+#define MILLION (THOUSAND * THOUSAND)+#define BILLION (THOUSAND * MILLION)++/* The number of tests in each battery */+#define SMALLCRUSH_NUM 10+#define CRUSH_NUM 96+#define BIGCRUSH_NUM 106+#define RABBIT_NUM 26+#define ALPHABIT_NUM 9+++double bbattery_pVal[1 + NDIM] = { 0 };+char *bbattery_TestNames[1 + NDIM] = { 0 };+int bbattery_NTests;++static char CharTemp[LEN + 1];++/* Gives the test number as enumerated in bbattery.tex. Some test applies+   more than one test, so the array of p-values does not correspond with +   the test number in the doc. */+static int TestNumber[1 + NDIM] = { 0 };+++++/*-------------------------------- Functions ------------------------------*/+++static void GetName (unif01_Gen * gen, char *genName)+{+   char *p;+   int len1, len2;++   if (NULL == gen) {+      genName[0] = '\0';+      return;+   }++   /* Print only the generator name, without the parameters or seeds. */+   /* The parameters start after the first blank; name ends with ':' */+   genName[LEN] = '\0';+   len1 = strcspn (gen->name, ":");+   len1 = util_Min (LEN, len1);+   strncpy (genName, gen->name, (size_t) len1);+   genName[len1] = '\0';+   /* For Filters or Combined generators */+   p = strstr (&gen->name[1 + len1], "unif01");+   while (p != NULL) {+      len1 += 2;+      if (len1 >= LEN)+         return;+      strcat (genName, ", ");+      len2 = strcspn (p, " \0");+      len2 = util_Min (LEN - len1, len2);+      if (len2 <= 0)+         return;+      strncat (genName, p, (size_t) len2);+      len1 = strlen (genName);+      genName[len1] = '\0';+      p += len2;+      p = strstr (p, "unif01");+   }+}+++/*=========================================================================*/++static void WritepVal (double p)+/*+ * Write a p-value with a nice format.+ */+{+   if (p < gofw_Suspectp) {+      gofw_Writep0 (p);++   } else if (p > 1.0 - gofw_Suspectp) {+      if (p >= 1.0 - gofw_Epsilonp1) {+         printf (" 1 - eps1");+      } else if (p >= 1.0 - 1.0e-4) {+         printf (" 1 - ");+         num_WriteD (1.0 - p, 7, 2, 2);+         /* printf (" 1 - %.2g ", 1.0 - p); */+      } else if (p >= 1.0 - 1.0e-2)+         printf ("  %.4f ", p);+      else+         printf ("   %.2f", p);+   }+}+++/*=========================================================================*/++static void WriteReport (+   char *genName,                 /* Generator or file name */+   char *batName,                 /* Battery name */+   int N,                         /* Max. number of tests */+   double pVal[],                 /* p-values of the tests */+   chrono_Chrono * Timer,         /* Timer */+   lebool Flag,                  /* = TRUE for a file, FALSE for a gen */+   lebool VersionFlag,           /* = TRUE: write the version number */+   double nb                      /* Number of bits in the random file */+   )+{+   int j, co;++   printf ("\n========= Summary results of ");+   printf ("%s", batName);+   printf (" =========\n\n");+   if (VersionFlag)+      printf (" Version:          %s\n", PACKAGE_STRING);+   if (Flag)+      printf (" File:             ");+   else+      printf (" Generator:        ");+   printf ("%s", genName);+   if (nb > 0)+      printf ("\n Number of bits:   %.0f", nb);+   co = 0;+   /* Some of the tests have not been done: their pVal[j] < 0. */+   for (j = 0; j < N; j++) {+      if (pVal[j] >= 0.0)+         co++;+   }+   printf ("\n Number of statistics:  %1d\n", co);+   printf (" Total CPU time:   ");+   chrono_Write (Timer, chrono_hms);++   co = 0;+   for (j = 0; j < N; j++) {+      if (pVal[j] < 0.0)          /* That test was not done: pVal = -1 */+         continue;+      if ((pVal[j] < gofw_Suspectp) || (pVal[j] > 1.0 - gofw_Suspectp)) {+         co++;+         break;+      }+   }+   if (co == 0) {+      printf ("\n\n All tests were passed\n\n\n\n");+      return;+   }++   if (gofw_Suspectp >= 0.01)+      printf ("\n The following tests gave p-values outside [%.4g, %.2f]",+         gofw_Suspectp, 1.0 - gofw_Suspectp);+   else if (gofw_Suspectp >= 0.0001)+      printf ("\n The following tests gave p-values outside [%.4g, %.4f]",+         gofw_Suspectp, 1.0 - gofw_Suspectp);+   else if (gofw_Suspectp >= 0.000001)+      printf ("\n The following tests gave p-values outside [%.4g, %.6f]",+         gofw_Suspectp, 1.0 - gofw_Suspectp);+   else+      printf ("\n The following tests gave p-values outside [%.4g, %.14f]",+         gofw_Suspectp, 1.0 - gofw_Suspectp);+   printf (":\n (eps  means a value < %6.1e)", gofw_Epsilonp);+   printf (":\n (eps1 means a value < %6.1e)", gofw_Epsilonp1);+   printf (":\n\n       Test                          p-value\n");+   printf (" ----------------------------------------------\n");++   co = 0;+   for (j = 0; j < N; j++) {+      if (pVal[j] < 0.0)          /* That test was not done: pVal = -1 */+         continue;+      if ((pVal[j] >= gofw_Suspectp) && (pVal[j] <= 1.0 - gofw_Suspectp))+         continue;                /* That test was passed */+      printf (" %2d ", TestNumber[j]);+      printf (" %-30s", bbattery_TestNames[j]);+      WritepVal (pVal[j]);+      printf ("\n");+      co++;+   }++   printf (" ----------------------------------------------\n");+   if (co < N - 1) {+      printf (" All other tests were passed\n");+   }+   printf ("\n\n\n");+}+++/*=========================================================================*/++static void GetPVal_Walk (long N, swalk_Res * res, int *pj, char *mess, int j2)+/*+ * Get the p-values in a swalk_RandomWalk1 test+ */+{+   int j = *pj;+   const unsigned int len = 20;++   if (N == 1) {+      bbattery_pVal[++j] = res->H[0]->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (CharTemp, "RandomWalk1 H");+      strncat (CharTemp, mess, (size_t) len);+      strncpy (bbattery_TestNames[j], CharTemp, (size_t) LEN);++      bbattery_pVal[++j] = res->M[0]->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (CharTemp, "RandomWalk1 M");+      strncat (CharTemp, mess, (size_t) len);+      strncpy (bbattery_TestNames[j], CharTemp, (size_t) LEN);++      bbattery_pVal[++j] = res->J[0]->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (CharTemp, "RandomWalk1 J");+      strncat (CharTemp, mess, (size_t) len);+      strncpy (bbattery_TestNames[j], CharTemp, (size_t) LEN);++      bbattery_pVal[++j] = res->R[0]->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (CharTemp, "RandomWalk1 R");+      strncat (CharTemp, mess, (size_t) len);+      strncpy (bbattery_TestNames[j], CharTemp, (size_t) LEN);++      bbattery_pVal[++j] = res->C[0]->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (CharTemp, "RandomWalk1 C");+      strncat (CharTemp, mess, (size_t) len);+      strncpy (bbattery_TestNames[j], CharTemp, (size_t) LEN);++   } else {+      bbattery_pVal[++j] = res->H[0]->pVal2[gofw_Sum];+      TestNumber[j] = j2;+      strcpy (CharTemp, "RandomWalk1 H");+      strncat (CharTemp, mess, (size_t) len);+      strncpy (bbattery_TestNames[j], CharTemp, (size_t) LEN);++      bbattery_pVal[++j] = res->M[0]->pVal2[gofw_Sum];+      TestNumber[j] = j2;+      strcpy (CharTemp, "RandomWalk1 M");+      strncat (CharTemp, mess, (size_t) len);+      strncpy (bbattery_TestNames[j], CharTemp, (size_t) LEN);++      bbattery_pVal[++j] = res->J[0]->pVal2[gofw_Sum];+      TestNumber[j] = j2;+      strcpy (CharTemp, "RandomWalk1 J");+      strncat (CharTemp, mess, (size_t) len);+      strncpy (bbattery_TestNames[j], CharTemp, (size_t) LEN);++      bbattery_pVal[++j] = res->R[0]->pVal2[gofw_Sum];+      TestNumber[j] = j2;+      strcpy (CharTemp, "RandomWalk1 R");+      strncat (CharTemp, mess, (size_t) len);+      strncpy (bbattery_TestNames[j], CharTemp, (size_t) LEN);++      bbattery_pVal[++j] = res->C[0]->pVal2[gofw_Sum];+      TestNumber[j] = j2;+      strcpy (CharTemp, "RandomWalk1 C");+      strncat (CharTemp, mess, (size_t) len);+      strncpy (bbattery_TestNames[j], CharTemp, (size_t) LEN);+   }++   *pj = j;+}+++/*=========================================================================*/++static void GetPVal_CPairs (long N, snpair_Res * res, int *pj, char *mess,+   int j2)+/*+ * Get the p-values in a snpair_ClosePairs test+ */+{+   int j = *pj;+   const unsigned int len = 20;++   if (N == 1) {+      bbattery_pVal[++j] = res->pVal[snpair_NP];+      TestNumber[j] = j2;+      strcpy (CharTemp, "ClosePairs NP");+      strncat (CharTemp, mess, (size_t) len);+      strcpy (bbattery_TestNames[j], CharTemp);++      bbattery_pVal[++j] = res->pVal[snpair_mNP];+      TestNumber[j] = j2;+      strcpy (CharTemp, "ClosePairs mNP");+      strncat (CharTemp, mess, (size_t) len);+      strcpy (bbattery_TestNames[j], CharTemp);++   } else {+      bbattery_pVal[++j] = res->pVal[snpair_NP];+      TestNumber[j] = j2;+      strcpy (CharTemp, "ClosePairs NP");+      strncat (CharTemp, mess, (size_t) len);+      strcpy (bbattery_TestNames[j], CharTemp);++      bbattery_pVal[++j] = res->pVal[snpair_mNP];+      TestNumber[j] = j2;+      strcpy (CharTemp, "ClosePairs mNP");+      strncat (CharTemp, mess, (size_t) len);+      strcpy (bbattery_TestNames[j], CharTemp);++      bbattery_pVal[++j] = res->pVal[snpair_mNP1];+      TestNumber[j] = j2;+      strcpy (CharTemp, "ClosePairs mNP1");+      strncat (CharTemp, mess, (size_t) len);+      strcpy (bbattery_TestNames[j], CharTemp);++      bbattery_pVal[++j] = res->pVal[snpair_mNP2];+      TestNumber[j] = j2;+      strcpy (CharTemp, "ClosePairs mNP2");+      strncat (CharTemp, mess, (size_t) len);+      strcpy (bbattery_TestNames[j], CharTemp);++      bbattery_pVal[++j] = res->pVal[snpair_NJumps];+      TestNumber[j] = j2;+      strcpy (CharTemp, "ClosePairs NJumps");+      strncat (CharTemp, mess, (size_t) len);+      strcpy (bbattery_TestNames[j], CharTemp);++      if (snpair_mNP2S_Flag) {+         bbattery_pVal[++j] = res->pVal[snpair_mNP2S];+         TestNumber[j] = j2;+         strcpy (CharTemp, "ClosePairs mNP2S");+         strncat (CharTemp, mess, (size_t) len);+         strcpy (bbattery_TestNames[j], CharTemp);+      }+   }++   *pj = j;+}+++/*=========================================================================*/++static void InitBat (void)+/*+ * Initializes the battery of tests: sets all p-values to -1.+ */+{+   int j;+   static int flag = 0;+   for (j = 0; j < NDIM; j++)+      bbattery_pVal[j] = -1.0;+   if (0 == flag) {+      flag++;+      for (j = 0; j < NDIM; j++)+         bbattery_TestNames[j] = util_Calloc (LEN + 1, sizeof (char));+   }+}+++/*=========================================================================*/++static BatteryResult* SmallCrush (unif01_Gen * gen, char *filename, int Rep[])+/*+ * A small battery of statistical tests for Random Number Generators + * used in simulation.+ * Rep[i] gives the number of times that test i will be done. The default+ * values are Rep[i] = 1 for all i.+ */+{+   swrite_Basic = 0;+   const int r = 0;+   int i;+   int j = -1;+   int j2 = 0;+   char genName[LEN + 1] = "";+   chrono_Chrono *Timer;+   sres_Poisson *res1;+   sres_Chi2 *res2;+   sknuth_Res2 *res3;+   swalk_Res *res4;+   sknuth_Res1 *res5;+   sstring_Res *res6;+   lebool fileFlag;++   Timer = chrono_Create ();+   InitBat ();+   if (swrite_Basic) {+      printf ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n"+         "                 Starting SmallCrush\n"+         "                 Version: %s\n"+         "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n\n\n",+         PACKAGE_STRING);+   }++   if (NULL == gen) {+      gen = ufile_CreateReadText (filename, 10 * MILLION);+      fileFlag = TRUE;+   } else+      fileFlag = FALSE;++   ++j2;+   if (fileFlag)+      ufile_InitReadText ();+   res1 = sres_CreatePoisson ();+   for (i = 0; i < Rep[j2]; ++i) {+#ifdef USE_LONGLONG+      smarsa_BirthdaySpacings (gen, res1, 1, 5 * MILLION, r, 1073741824,+         2, 1);+#else+      smarsa_BirthdaySpacings (gen, res1, 10, MILLION / 2, r, 67108864, 2, 1);+#endif+      bbattery_pVal[++j] = res1->pVal2;+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "BirthdaySpacings");+   }+   sres_DeletePoisson (res1);++   if (fileFlag)+      ufile_InitReadText ();+   ++j2;+   res3 = sknuth_CreateRes2 ();+   for (i = 0; i < Rep[j2]; ++i) {+      sknuth_Collision (gen, res3, 1, 5 * MILLION, 0, 65536, 2);+      bbattery_pVal[++j] = res3->Pois->pVal2;+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "Collision");+   }+   sknuth_DeleteRes2 (res3);++   if (fileFlag)+      ufile_InitReadText ();+   ++j2;+   res2 = sres_CreateChi2 ();+   for (i = 0; i < Rep[j2]; ++i) {+      sknuth_Gap (gen, res2, 1, MILLION / 5, 22, 0.0, .00390625);+      bbattery_pVal[++j] = res2->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "Gap");+   }++   ++j2;+   if (fileFlag)+      ufile_InitReadText ();+   for (i = 0; i < Rep[j2]; ++i) {+      sknuth_SimpPoker (gen, res2, 1, 2 * MILLION / 5, 24, 64, 64);+      bbattery_pVal[++j] = res2->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "SimpPoker");+   }++   ++j2;+   if (fileFlag)+      ufile_InitReadText ();+   for (i = 0; i < Rep[j2]; ++i) {+      sknuth_CouponCollector (gen, res2, 1, MILLION / 2, 26, 16);+      bbattery_pVal[++j] = res2->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "CouponCollector");+   }++   if (fileFlag)+      ufile_InitReadText ();+   ++j2;+   res5 = sknuth_CreateRes1 ();+   for (i = 0; i < Rep[j2]; ++i) {+      sknuth_MaxOft (gen, res5, 1, 2 * MILLION, 0, MILLION / 10, 6);+      bbattery_pVal[++j] = res5->Chi->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "MaxOft");+      bbattery_pVal[++j] = res5->Bas->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "MaxOft AD");+   }+   sknuth_DeleteRes1 (res5);++   ++j2;+   if (fileFlag)+      ufile_InitReadText ();+   for (i = 0; i < Rep[j2]; ++i) {+      svaria_WeightDistrib (gen, res2, 1, MILLION / 5, 27, 256, 0.0, 0.125);+      bbattery_pVal[++j] = res2->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "WeightDistrib");+   }++   ++j2;+   if (fileFlag)+      ufile_InitReadText ();+   for (i = 0; i < Rep[j2]; ++i) {+      smarsa_MatrixRank (gen, res2, 1, 20 * THOUSAND, 20, 10, 60, 60);+      bbattery_pVal[++j] = res2->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "MatrixRank");+   }+   sres_DeleteChi2 (res2);++   if (fileFlag)+      ufile_InitReadText ();+   ++j2;+   res6 = sstring_CreateRes ();+   for (i = 0; i < Rep[j2]; ++i) {+      sstring_HammingIndep (gen, res6, 1, MILLION/2, 20, 10, 300, 0);+      bbattery_pVal[++j] = res6->Bas->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "HammingIndep");+   }+   sstring_DeleteRes (res6);++   if (fileFlag)+      ufile_InitReadText ();+   ++j2;+   util_Assert (j2 <= SMALLCRUSH_NUM, "SmallCrush:   j2 > SMALLCRUSH_NUM");+   res4 = swalk_CreateRes ();+   for (i = 0; i < Rep[j2]; ++i) {+      swalk_RandomWalk1 (gen, res4, 1, MILLION, r, 30, 150, 150);+      GetPVal_Walk (1, res4, &j, "", j2);+   }+   swalk_DeleteRes (res4);++   bbattery_NTests = ++j;+   chrono_Delete (Timer);+   return wrap(bbattery_pVal, bbattery_NTests);+}+++/*=========================================================================*/++BatteryResult* bbattery_SmallCrush (unif01_Gen * gen)+{+   int i;+   int Rep[1 + NDIM] = {0};+   for (i = 1; i <= SMALLCRUSH_NUM; ++i)+      Rep[i] = 1;+   return SmallCrush (gen, NULL, Rep);+}+++/*=========================================================================*/++void bbattery_SmallCrushFile (char *filename)+{+   int i;+   int Rep[1 + NDIM] = {0};+   for (i = 1; i <= SMALLCRUSH_NUM; ++i)+      Rep[i] = 1;+   SmallCrush (NULL, filename, Rep);+}+++/*=========================================================================*/++void bbattery_RepeatSmallCrush (unif01_Gen * gen, int Rep[])+{+   SmallCrush (gen, NULL, Rep);+}+++/*=========================================================================*/++static BatteryResult* Crush (unif01_Gen * gen, int Rep[])+/*+ * A battery of stringent statistical tests for Random Number Generators+ * used in simulation.+ * Rep[i] gives the number of times that test i will be done. The default+ * values are Rep[i] = 1 for all i.+ */+{+   swrite_Basic = 0;+   const int s = 30;+   const int r = 0;+   int i;+   chrono_Chrono *Timer;+   char genName[LEN + 1] = "";+   int j = -1;+   int j2 = 0;++   Timer = chrono_Create ();+   InitBat ();+   if (swrite_Basic) {+      printf ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n"+         "                 Starting Crush\n"+         "                 Version: %s\n"+         "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n\n\n",+         PACKAGE_STRING);+   }+   {+      sres_Basic *res;+      res = sres_CreateBasic ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_SerialOver (gen, res, 1, 500 * MILLION, 0, 4096, 2);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SerialOver, t = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_SerialOver (gen, res, 1, 300 * MILLION, 0, 64, 4);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SerialOver, t = 4");+      }+      sres_DeleteBasic (res);+   }+   {+      smarsa_Res *res;+      res = smarsa_CreateRes ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, res, 10, 10 * MILLION, 0, 1024 * 1024, 2);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, res, 10, 10 * MILLION, 10, 1024 * 1024, 2);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, res, 10, 10 * MILLION, 0, 1024, 4);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 4");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, res, 10, 10 * MILLION, 20, 1024, 4);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 4");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, res, 10, 10 * MILLION, 0, 32, 8);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 8");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, res, 10, 10 * MILLION, 25, 32, 8);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 8");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, res, 10, 10 * MILLION, 0, 4, 20);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 20");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, res, 10, 10 * MILLION, 28, 4, 20);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 20");+      }+      smarsa_DeleteRes (res);+   }+   {+      sres_Poisson *res;+      res = sres_CreatePoisson ();++#ifdef USE_LONGLONG+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         long d;+#if LONG_MAX <= 2147483647L+         d = 1073741824L;+         smarsa_BirthdaySpacings (gen, res, 10, 10 * MILLION, 0, d, 2, 1);+#else+         d = 2*1073741824L;+         smarsa_BirthdaySpacings (gen, res, 5, 20 * MILLION, 0, d, 2, 1);+#endif+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 5, 20 * MILLION, 0, 2097152, 3,+            1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 3");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 5, 20 * MILLION, 0, 65536, 4, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 4");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 3, 20 * MILLION, 0, 512, 7, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 7");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 3, 20 * MILLION, 7, 512, 7, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 7");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 3, 20 * MILLION, 14, 256, 8, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 8");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 3, 20 * MILLION, 22, 256, 8, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 8");+      }++#else+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 200, 4 * MILLION / 10, 0,+            67108864, 2, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 100, 4 * MILLION / 10, 0, 131072,+            3, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 3");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 200, 4 * MILLION / 10, 0,+            1024 * 8, 4, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 4");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 100, 4 * MILLION / 10, 0, 16, 13,+            1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 13");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 100, 4 * MILLION / 10, 10, 16,+            13, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 13");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 100, 4 * MILLION / 10, 20, 16,+            13, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 13");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 100, 4 * MILLION / 10, 26, 16,+            13, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 13");+      }+#endif++      sres_DeletePoisson (res);+   }+   {+      lebool flag = snpair_mNP2S_Flag;+      snpair_Res *res;+      res = snpair_CreateRes ();++      snpair_mNP2S_Flag = FALSE;+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairs (gen, res, 10, 2 * MILLION, 0, 2, 0, 30);+         GetPVal_CPairs (10, res, &j, ", t = 2", j2);+      }++      snpair_mNP2S_Flag = TRUE;+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairs (gen, res, 10, 2 * MILLION, 0, 3, 0, 30);+         GetPVal_CPairs (10, res, &j, ", t = 3", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairs (gen, res, 5, 2 * MILLION, 0, 7, 0, 30);+         GetPVal_CPairs (10, res, &j, ", t = 7", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairsBitMatch (gen, res, 4, 4 * MILLION, 0, 2);+         bbattery_pVal[++j] = res->pVal[snpair_BM];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "ClosePairsBitMatch, t = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairsBitMatch (gen, res, 2, 4 * MILLION, 0, 4);+         bbattery_pVal[++j] = res->pVal[snpair_BM];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "ClosePairsBitMatch, t = 4");+      }+      snpair_DeleteRes (res);+      snpair_mNP2S_Flag = flag;+   }+   {+      sres_Chi2 *res;+      res = sres_CreateChi2 ();++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_SimpPoker (gen, res, 1, 40 * MILLION, 0, 16, 16);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SimpPoker, d = 16");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_SimpPoker (gen, res, 1, 40 * MILLION, 26, 16, 16);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SimpPoker, d = 16");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_SimpPoker (gen, res, 1, 10 * MILLION, 0, 64, 64);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SimpPoker, d = 64");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_SimpPoker (gen, res, 1, 10 * MILLION, 24, 64, 64);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SimpPoker, d = 64");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CouponCollector (gen, res, 1, 40 * MILLION, 0, 4);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CouponCollector, d = 4");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CouponCollector (gen, res, 1, 40 * MILLION, 28, 4);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CouponCollector, d = 4");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CouponCollector (gen, res, 1, 10 * MILLION, 0, 16);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CouponCollector, d = 16");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CouponCollector (gen, res, 1, 10 * MILLION, 26, 16);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CouponCollector, d = 16");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Gap (gen, res, 1, 100 * MILLION, 0, 0.0, 0.125);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Gap, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Gap (gen, res, 1, 100 * MILLION, 27, 0.0, 0.125);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Gap, r = 27");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Gap (gen, res, 1, 5 * MILLION, 0, 0.0, 1.0/256.0);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Gap, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Gap (gen, res, 1, 5 * MILLION, 22, 0.0, 1.0/256.0);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Gap, r = 22");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Run (gen, res, 1, 500 * MILLION, 0, TRUE);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of U01, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Run (gen, res, 1, 500 * MILLION, 15, FALSE);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of U01, r = 15");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Permutation (gen, res, 1, 50 * MILLION, 0, 10);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Permutation, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Permutation (gen, res, 1, 50 * MILLION, 15, 10);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Permutation, r = 15");+      }+      sres_DeleteChi2 (res);+   }+   {+      sknuth_Res2 *res;+      res = sknuth_CreateRes2 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CollisionPermut (gen, res, 5, 10 * MILLION, 0, 13);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionPermut, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CollisionPermut (gen, res, 5, 10 * MILLION, 15, 13);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionPermut, r = 15");+      }+      sknuth_DeleteRes2 (res);+   }+   {+      sknuth_Res1 *res;+      res = sknuth_CreateRes1 ();++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_MaxOft (gen, res, 10, 10 * MILLION, 0, MILLION / 10, 5);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft, t = 5");+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft AD, t = 5");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_MaxOft (gen, res, 5, 10 * MILLION, 0, MILLION / 10, 10);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft, t = 10");+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft AD, t = 10");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_MaxOft (gen, res, 1, 10 * MILLION, 0, MILLION / 10, 20);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft, t = 20");+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft AD, t = 20");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_MaxOft (gen, res, 1, 10 * MILLION, 0, MILLION / 10, 30);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft, t = 30");+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft AD, t = 30");+      }+      sknuth_DeleteRes1 (res);+   }+   {+      sres_Basic *res;+      res = sres_CreateBasic ();++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleProd (gen, res, 1, 10 * MILLION, 0, 10);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleProd, t = 10");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleProd (gen, res, 1, 10 * MILLION, 0, 30);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleProd, t = 30");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleMean (gen, res, 10*MILLION, 20, 0);+         bbattery_pVal[++j] = res->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleMean");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleCorr (gen, res, 1, 500 * MILLION, 0, 1);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleCorr");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_AppearanceSpacings (gen, res, 1, 10 * MILLION, 400 * MILLION,+            r, 30, 15);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AppearanceSpacings, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_AppearanceSpacings (gen, res, 1, 10 * MILLION, 100 * MILLION,+            20, 10, 15);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AppearanceSpacings, r = 20");+      }+      sres_DeleteBasic (res);+   }+   {+      smarsa_Res2 *res2;+      sres_Chi2 *res;+      res = sres_CreateChi2 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_WeightDistrib (gen, res, 1, 2 * MILLION, 0, 256, 0.0, 0.125);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "WeightDistrib, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_WeightDistrib (gen, res, 1, 2 * MILLION, 8, 256, 0.0, 0.125);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "WeightDistrib, r = 8");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_WeightDistrib (gen, res, 1, 2 * MILLION, 16, 256, 0.0, 0.125);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "WeightDistrib, r = 16");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_WeightDistrib (gen, res, 1, 2 * MILLION, 24, 256, 0.0, 0.125);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "WeightDistrib, r = 24");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SumCollector (gen, res, 1, 20 * MILLION, 0, 10.0);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SumCollector");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 1, MILLION, r, s, 2 * s, 2 * s);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, 60 x 60");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 1, MILLION, 20, 10, 2 * s, 2 * s);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, 60 x 60");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 1, 50 * THOUSAND, r, s, 10 * s, 10 * s);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, 300 x 300");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 1, 50 * THOUSAND, 20, 10, 10 * s,+            10 * s);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, 300 x 300");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 1, 2 * THOUSAND, r, s, 40 * s, 40 * s);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, 1200 x 1200");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 1, 2 * THOUSAND, 20, 10, 40 * s, 40 * s);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, 1200 x 1200");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_Savir2 (gen, res, 1, 20 * MILLION, 0, 1024*1024, 30);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Savir2");+      }+      sres_DeleteChi2 (res);++      res2 = smarsa_CreateRes2 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_GCD (gen, res2, 1, 100 * MILLION, 0, 30);+         bbattery_pVal[++j] = res2->GCD->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "GCD, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_GCD (gen, res2, 1, 40 * MILLION, 10, 20);+         bbattery_pVal[++j] = res2->GCD->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "GCD, r = 10");+      }+      smarsa_DeleteRes2 (res2);+   }+   {+      swalk_Res *res;+      res = swalk_CreateRes ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, 50 * MILLION, r, s, 90, 90);+         GetPVal_Walk (1, res, &j, " (L = 90)", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, 10 * MILLION, 20, 10, 90, 90);+         GetPVal_Walk (1, res, &j, " (L = 90)", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, 5 * MILLION, r, s, 1000, 1000);+         GetPVal_Walk (1, res, &j, " (L = 1000)", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, MILLION, 20, 10, 1000, 1000);+         GetPVal_Walk (1, res, &j, " (L = 1000)", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, MILLION / 2, r, s, 10000, 10000);+         GetPVal_Walk (1, res, &j, " (L = 10000)", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, MILLION / 10, 20, 10, 10000, 10000);+         GetPVal_Walk (1, res, &j, " (L = 10000)", j2);+      }+      swalk_DeleteRes (res);+   }+   {+      scomp_Res *res;+      res = scomp_CreateRes ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         scomp_LinearComp (gen, res, 1, 120 * THOUSAND, r, 1);+         bbattery_pVal[++j] = res->JumpNum->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LinearComp, r = 0");+         bbattery_pVal[++j] = res->JumpSize->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LinearComp, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         scomp_LinearComp (gen, res, 1, 120 * THOUSAND, 29, 1);+         bbattery_pVal[++j] = res->JumpNum->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LinearComp, r = 29");+         bbattery_pVal[++j] = res->JumpSize->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LinearComp, r = 29");+      }+      scomp_DeleteRes (res);+   }+   {+      sres_Basic *res;+      res = sres_CreateBasic ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         scomp_LempelZiv (gen, res, 10, 25, r, s);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LempelZiv");+      }+      sres_DeleteBasic (res);+   }+   {+      sspectral_Res *res;+      res = sspectral_CreateRes ();++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sspectral_Fourier3 (gen, res, 50 * THOUSAND, 14, r, s);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Fourier3, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sspectral_Fourier3 (gen, res, 50 * THOUSAND, 14, 20, 10);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Fourier3, r = 20");+      }+      sspectral_DeleteRes (res);+   }+   {+      sstring_Res2 *res;+      res = sstring_CreateRes2 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_LongestHeadRun (gen, res, 1, 1000, r, s, 20 + 10 * MILLION);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LongestHeadRun, r = 0");+         bbattery_pVal[++j] = res->Disc->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LongestHeadRun, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_LongestHeadRun (gen, res, 1, 300, 20, 10, 20 + 10 * MILLION);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LongestHeadRun, r = 20");+         bbattery_pVal[++j] = res->Disc->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LongestHeadRun, r = 20");+      }+      sstring_DeleteRes2 (res);+   }+   {+      sres_Chi2 *res;+      res = sres_CreateChi2 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_PeriodsInStrings (gen, res, 1, 300 * MILLION, r, s);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "PeriodsInStrings, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_PeriodsInStrings (gen, res, 1, 300 * MILLION, 15, 15);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "PeriodsInStrings, r = 15");+      }+      sres_DeleteChi2 (res);+   }+   {+      sres_Basic *res;+      res = sres_CreateBasic ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingWeight2 (gen, res, 100, 100 * MILLION, r, s, MILLION);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingWeight2, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingWeight2 (gen, res, 30, 100 * MILLION, 20, 10, MILLION);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingWeight2, r = 20");+      }+      sres_DeleteBasic (res);+   }+   {+      sstring_Res *res;+      res = sstring_CreateRes ();+      /* sstring_HammingCorr will probably be removed: less sensitive than+         svaria_HammingIndep */+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingCorr (gen, res, 1, 500 * MILLION, r, s, s);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingCorr, L = 30");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingCorr (gen, res, 1, 50 * MILLION, r, s, 10 * s);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingCorr, L = 300");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingCorr (gen, res, 1, 10 * MILLION, r, s, 40 * s);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingCorr, L = 1200");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 1, 300 * MILLION, r, s, s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L = 30");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 1, 100 * MILLION, 20, 10, s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L = 30");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 1, 30 * MILLION, r, s, 10 * s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L = 300");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 1, 10 * MILLION, 20, 10, 10 * s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L = 300");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 1, 10 * MILLION, r, s, 40 * s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L = 1200");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 1, MILLION, 20, 10, 40 * s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L = 1200");+      }+      sstring_DeleteRes (res);+   }+   {+      sstring_Res3 *res;+      res = sstring_CreateRes3 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_Run (gen, res, 1, 1 * BILLION, r, s);+         bbattery_pVal[++j] = res->NRuns->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of bits, r = 0");+         bbattery_pVal[++j] = res->NBits->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of bits, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_Run (gen, res, 1, 1 * BILLION, 20, 10);+         bbattery_pVal[++j] = res->NRuns->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of bits, r = 20");+         bbattery_pVal[++j] = res->NBits->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of bits, r = 20");+      }+      sstring_DeleteRes3 (res);+   }+   {+      sres_Basic *res;+      res = sres_CreateBasic ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_AutoCor (gen, res, 10, 30 + BILLION, r, s, 1);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AutoCor, d = 1");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_AutoCor (gen, res, 5, 1 + BILLION, 20, 10, 1);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AutoCor, d = 1");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_AutoCor (gen, res, 10, 31 + BILLION, r, s, s);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AutoCor, d = 30");+      }++      ++j2;+ /*     util_Assert (j2 <= CRUSH_NUM, "Crush:   j2 > CRUSH_NUM");  */+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_AutoCor (gen, res, 5, 11 + BILLION, 20, 10, 10);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AutoCor, d = 10");+      }+      sres_DeleteBasic (res);+   }++   bbattery_NTests = ++j;+   GetName (gen, genName);+   chrono_Delete (Timer);+   return wrap(bbattery_pVal, bbattery_NTests);+}+++/*=========================================================================*/++BatteryResult* bbattery_Crush (unif01_Gen * gen)+{+   int i;+   int Rep[NDIM + 1] = {0};+   for (i = 1; i <= CRUSH_NUM; ++i)+      Rep[i] = 1;+   return Crush (gen, Rep);+}+++/*=========================================================================*/++void bbattery_RepeatCrush (unif01_Gen * gen, int Rep[])+{+   Crush (gen, Rep);+}+++/*=========================================================================*/++static BatteryResult* BigCrush (unif01_Gen * gen, int Rep[])+/*+ * A battery of very stringent statistical tests for Random Number Generators+ * used in simulation.+ * Rep[i] gives the number of times that test i will be done. The default+ * values are Rep[i] = 1 for all i.+ */+{+   swrite_Basic = 0;+   const int s = 30;+   const int r = 0;+   int i;+   chrono_Chrono *Timer;+   char genName[LEN + 1] = "";+   int j = -1;+   int j2 = 0;++   Timer = chrono_Create ();+   InitBat ();+   if (swrite_Basic) {+      printf ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n"+         "                 Starting BigCrush\n"+         "                 Version: %s\n"+         "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n\n\n",+         PACKAGE_STRING);+   }+   {+      sres_Basic *res;+      res = sres_CreateBasic ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_SerialOver (gen, res, 1, BILLION, 0, 256, 3);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SerialOver, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_SerialOver (gen, res, 1, BILLION, 22, 256, 3);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SerialOver, r = 22");+      }+      sres_DeleteBasic (res);+   }+   {+      smarsa_Res *resm;+      resm = smarsa_CreateRes ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, resm, 30, 20 * MILLION, 0, 1024*1024*2, 2);+         bbattery_pVal[++j] = resm->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, resm, 30, 20 * MILLION, 9, 1024*1024*2, 2);+         bbattery_pVal[++j] = resm->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, resm, 30, 20 * MILLION, 0, 1024*16, 3);+         bbattery_pVal[++j] = resm->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 3");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, resm, 30, 20 * MILLION, 16, 1024*16, 3);+         bbattery_pVal[++j] = resm->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 3");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, resm, 30, 20 * MILLION, 0, 64, 7);+         bbattery_pVal[++j] = resm->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 7");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, resm, 30, 20 * MILLION, 24, 64, 7);+         bbattery_pVal[++j] = resm->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 7");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, resm, 30, 20 * MILLION, 0, 8, 14);+         bbattery_pVal[++j] = resm->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 14");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, resm, 30, 20 * MILLION, 27, 8, 14);+         bbattery_pVal[++j] = resm->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 14");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, resm, 30, 20 * MILLION, 0, 4, 21);+         bbattery_pVal[++j] = resm->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 21");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_CollisionOver (gen, resm, 30, 20 * MILLION, 28, 4, 21);+         bbattery_pVal[++j] = resm->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionOver, t = 21");+      }+      smarsa_DeleteRes (resm);+   }+   {+      sres_Poisson *res;+      res = sres_CreatePoisson ();+#ifdef USE_LONGLONG+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         long d;+#if LONG_MAX <= 2147483647L+         d = 1073741824L;+         smarsa_BirthdaySpacings (gen, res, 250, 4 * MILLION, 0, d, 2, 1);+#else+         d = 2147483648L;+         smarsa_BirthdaySpacings (gen, res, 100, 10 * MILLION, 0, d, 2, 1);+#endif+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 20, 20 * MILLION, 0, 2097152, 3,+            1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 3");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 20, 30 * MILLION, 14, 65536, 4, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 4");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 20, 20 * MILLION, 0, 512, 7, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 7");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 20, 20 * MILLION, 7, 512, 7, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 7");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 20, 30 * MILLION, 14, 256, 8, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 8");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 20, 30 * MILLION, 22, 256, 8, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 8");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 20, 30 * MILLION, 0, 16, 16, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 16");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 20, 30 * MILLION, 26, 16, 16, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 16");+      }++#else+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 10 * THOUSAND, MILLION / 10, 0,+            67108864, 2, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 10 * THOUSAND, MILLION / 10, 0,+            1024 * 8, 4, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 4");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 10 * THOUSAND, MILLION / 10, 16,+            1024 * 8, 4, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 4");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 10 * THOUSAND, MILLION / 10, 0, 16,+            13, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 13");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 10 * THOUSAND, MILLION / 10, 5, 16,+            13, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 13");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 10 * THOUSAND, MILLION / 10, 10,+            16, 13, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 13");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 10 * THOUSAND, MILLION / 10, 15,+            16, 13, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 13");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 10 * THOUSAND, MILLION / 10, 20,+            16, 13, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 13");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_BirthdaySpacings (gen, res, 10 * THOUSAND, MILLION / 10, 26,+            16, 13, 1);+         bbattery_pVal[++j] = res->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings, t = 13");+      }+#endif+      sres_DeletePoisson (res);+   }+   {+      lebool flag = snpair_mNP2S_Flag;+      snpair_Res *res;+      res = snpair_CreateRes ();++      snpair_mNP2S_Flag = TRUE;+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairs (gen, res, 30, 6 * MILLION, 0, 3, 0, 30);+         GetPVal_CPairs (40, res, &j, ", t = 3", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairs (gen, res, 20, 4 * MILLION, 0, 5, 0, 30);+         GetPVal_CPairs (40, res, &j, ", t = 5", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairs (gen, res, 10, 3 * MILLION, 0, 9, 0, 30);+         GetPVal_CPairs (20, res, &j, ", t = 9", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairs (gen, res, 5, 2*MILLION, 0, 16, 0, 30);+         GetPVal_CPairs (10, res, &j, ", t = 16", j2);+      }+      snpair_DeleteRes (res);+      snpair_mNP2S_Flag =flag;+   }+   {+      sres_Chi2 *res;+      res = sres_CreateChi2 ();++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_SimpPoker (gen, res, 1, 400 * MILLION, 0, 8, 8);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SimpPoker, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_SimpPoker (gen, res, 1, 400 * MILLION, 27, 8, 8);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SimpPoker, r = 27");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_SimpPoker (gen, res, 1, 100 * MILLION, 0, 32, 32);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SimpPoker, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_SimpPoker (gen, res, 1, 100 * MILLION, 25, 32, 32);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SimpPoker, r = 25");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CouponCollector (gen, res, 1, 200 * MILLION, 0, 8);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CouponCollector, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CouponCollector (gen, res, 1, 200 * MILLION, 10, 8);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CouponCollector, r = 10");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CouponCollector (gen, res, 1, 200 * MILLION, 20, 8);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CouponCollector, r = 20");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CouponCollector (gen, res, 1, 200 * MILLION, 27, 8);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CouponCollector, r = 27");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Gap (gen, res, 1, BILLION/2, 0, 0.0, 1.0/16.0);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Gap, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Gap (gen, res, 1, 300*MILLION, 25, 0.0, 1.0/32.0);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Gap, r = 25");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Gap (gen, res, 1, BILLION/10, 0, 0.0, 1.0/128.0);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Gap, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Gap (gen, res, 1, 10*MILLION, 20, 0.0, 1.0/1024.0);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Gap, r = 20");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Run (gen, res, 5, BILLION, 0, FALSE);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Run (gen, res, 10, BILLION, 15, TRUE);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run, r = 15");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Permutation (gen, res, 1, BILLION, 5, 3);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Permutation, t = 3" );+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Permutation (gen, res, 1, BILLION, 5, 5);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Permutation, t = 5");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Permutation (gen, res, 1, BILLION/2, 5, 7);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Permutation, t = 7");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_Permutation (gen, res, 1, BILLION/2, 10, 10);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Permutation, t = 10");+      }+      sres_DeleteChi2 (res);+   }+   {+      sknuth_Res2 *res;+      res = sknuth_CreateRes2 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CollisionPermut (gen, res, 20, 20 * MILLION, 0, 14);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionPermut, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_CollisionPermut (gen, res, 20, 20 * MILLION, 10, 14);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "CollisionPermut, r = 10");+      }+      sknuth_DeleteRes2 (res);+   }+   {+      sknuth_Res1 *res;+      res = sknuth_CreateRes1 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_MaxOft (gen, res, 40, 10 * MILLION, 0, MILLION / 10, 8);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft, t = 8");+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft AD, t = 8");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_MaxOft (gen, res, 30, 10 * MILLION, 0, MILLION / 10, 16);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft, t = 16");+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft AD, t = 16");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_MaxOft (gen, res, 20, 10 * MILLION, 0, MILLION / 10, 24);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft, t = 24");+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft AD, t = 24");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sknuth_MaxOft (gen, res, 20, 10 * MILLION, 0, MILLION / 10, 32);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft, t = 32");+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MaxOft AD, t = 32");+      }+      sknuth_DeleteRes1 (res);+   }+   {+      sres_Basic *res;+      res = sres_CreateBasic ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleProd (gen, res, 40, 10 * MILLION, 0, 8);+         bbattery_pVal[++j] = res->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleProd, t = 8");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleProd (gen, res, 20, 10*MILLION, 0, 16);+         bbattery_pVal[++j] = res->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleProd, t = 16");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleProd (gen, res, 20, 10*MILLION, 0, 24);+         bbattery_pVal[++j] = res->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleProd, t = 24");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleMean (gen, res, 20*MILLION, 30, 0);+         bbattery_pVal[++j] = res->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleMean, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleMean (gen, res, 20*MILLION, 30, 10);+         bbattery_pVal[++j] = res->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleMean, r = 10");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleCorr (gen, res, 1, 2*BILLION, 0, 1);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleCorr, k = 1");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SampleCorr (gen, res, 1, 2*BILLION, 0, 2);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SampleCorr, k = 2");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_AppearanceSpacings (gen, res, 1, 10 * MILLION, BILLION,+            r, 3, 15);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AppearanceSpacings, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_AppearanceSpacings (gen, res, 1, 10 * MILLION, BILLION,+            27, 3, 15);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AppearanceSpacings, r = 27");+      }+      sres_DeleteBasic (res);+   }+   {+      smarsa_Res2 *res2;+      sres_Chi2 *res;+      res = sres_CreateChi2 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_WeightDistrib (gen, res, 1, 20 * MILLION, 0, 256, 0.0, 0.25);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "WeightDistrib, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_WeightDistrib (gen, res, 1, 20 * MILLION, 20, 256, 0.0, 0.25);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "WeightDistrib, r = 20");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_WeightDistrib (gen, res, 1, 20 * MILLION, 28, 256, 0.0, 0.25);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "WeightDistrib, r = 28");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_WeightDistrib (gen, res, 1, 20 * MILLION, 0, 256, 0.0, 0.0625);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "WeightDistrib, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_WeightDistrib (gen, res, 1, 20 * MILLION, 10, 256, 0.0, 0.0625);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "WeightDistrib, r = 10");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_WeightDistrib (gen, res, 1, 20 * MILLION, 26, 256, 0.0, 0.0625);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "WeightDistrib, r = 26");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         svaria_SumCollector (gen, res, 1, 500 * MILLION, 0, 10.0);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "SumCollector");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 10, MILLION, r, 5, 30, 30);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, L=30, r=0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 10, MILLION, 25, 5, 30, 30);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, L=30, r=26");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 1, 5 * THOUSAND, r, 4, 1000, 1000);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, L=1000, r=0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 1, 5 * THOUSAND, 26, 4, 1000, 1000);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, L=1000, r=26");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 1, 80, 15, 15, 5000, 5000);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, L=5000");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_MatrixRank (gen, res, 1, 80, 0, 30, 5000, 5000);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank, L=5000");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_Savir2 (gen, res, 10, 10 * MILLION, 10, 1024*1024, 30);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Savir2");+      }+      sres_DeleteChi2 (res);++      res2 = smarsa_CreateRes2 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smarsa_GCD (gen, res2, 10, 50 * MILLION, 0, 30);+         bbattery_pVal[++j] = res2->GCD->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "GCD");+      }+      smarsa_DeleteRes2 (res2);+   }+   {+      swalk_Res *res;+      res = swalk_CreateRes ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, 100 * MILLION, r, 5, 50, 50);+         GetPVal_Walk (1, res, &j, " (L=50, r=0)", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, 100 * MILLION, 25, 5, 50, 50);+         GetPVal_Walk (1, res, &j, " (L=50, r=25)", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, 10 * MILLION, r, 10, 1000, 1000);+         GetPVal_Walk (1, res, &j, " (L=1000, r=0)", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, 10 * MILLION, 20, 10, 1000, 1000);+         GetPVal_Walk (1, res, &j, " (L=1000, r=20)", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, 1 * MILLION, r, 15, 10000, 10000);+         GetPVal_Walk (1, res, &j, " (L=10000, r=0)", j2);+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         swalk_RandomWalk1 (gen, res, 1, 1 * MILLION, 15, 15, 10000, 10000);+         GetPVal_Walk (1, res, &j, " (L=10000, r=15)", j2);+      }+      swalk_DeleteRes (res);+   }+   {+      scomp_Res *res;+      res = scomp_CreateRes ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         scomp_LinearComp (gen, res, 1, 400 * THOUSAND + 20, r, 1);+         bbattery_pVal[++j] = res->JumpNum->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LinearComp, r = 0");+         bbattery_pVal[++j] = res->JumpSize->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LinearComp, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         scomp_LinearComp (gen, res, 1, 400 * THOUSAND + 20, 29, 1);+         bbattery_pVal[++j] = res->JumpNum->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LinearComp, r = 29");+         bbattery_pVal[++j] = res->JumpSize->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LinearComp, r = 0");+      }+      scomp_DeleteRes (res);+   }+   {+      sres_Basic *res;+      res = sres_CreateBasic ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         scomp_LempelZiv (gen, res, 10, 27, r, s);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LempelZiv, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         scomp_LempelZiv (gen, res, 10, 27, 15, 15);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LempelZiv, r = 15");+      }+      sres_DeleteBasic (res);+   }+   {+      sspectral_Res *res;+      res = sspectral_CreateRes ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sspectral_Fourier3 (gen, res, 100 * THOUSAND, 14, r, 3);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Fourier3, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sspectral_Fourier3 (gen, res, 100 * THOUSAND, 14, 27, 3);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Fourier3, r = 27");+      }+      sspectral_DeleteRes (res);+   }+   {+      sstring_Res2 *res;+      res = sstring_CreateRes2 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_LongestHeadRun (gen, res, 1, 1000, r, 3, 20 + 10 * MILLION);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LongestHeadRun, r = 0");+         bbattery_pVal[++j] = res->Disc->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LongestHeadRun, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_LongestHeadRun (gen, res, 1, 1000, 27, 3, 20 + 10 * MILLION);+         bbattery_pVal[++j] = res->Chi->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LongestHeadRun, r = 27");+         bbattery_pVal[++j] = res->Disc->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LongestHeadRun, r = 27");+      }+      sstring_DeleteRes2 (res);+   }+   {+      sres_Chi2 *res;+      res = sres_CreateChi2 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_PeriodsInStrings (gen, res, 10, BILLION/2, r, 10);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "PeriodsInStrings, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_PeriodsInStrings (gen, res, 10, BILLION/2, 20, 10);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "PeriodsInStrings, r = 20");+      }+      sres_DeleteChi2 (res);+   }+   {+      sres_Basic *res;+      res = sres_CreateBasic ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingWeight2 (gen, res, 10, BILLION, r, 3, MILLION);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingWeight2, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingWeight2 (gen, res, 10, BILLION, 27, 3, MILLION);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingWeight2, r = 27");+      }+      sres_DeleteBasic (res);+   }+   {+      sstring_Res *res;+      res = sstring_CreateRes ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingCorr (gen, res, 1, BILLION, 10, 10, s);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingCorr, L = 30");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingCorr (gen, res, 1, 100 * MILLION, 10, 10, 10 * s);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingCorr, L = 300");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingCorr (gen, res, 1, 100 * MILLION, 10, 10, 40 * s);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingCorr, L = 1200");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 10, 30 * MILLION, r, 3, s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L=30, r=0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 10, 30 * MILLION, 27, 3, s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L=30, r=27");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 1, 30 * MILLION, r, 4, 10 * s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L=300, r=0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 1, 30 * MILLION, 26, 4, 10 * s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L=300, r=26");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 1, 10 * MILLION, r, 5, 40 * s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L=1200, r=0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingIndep (gen, res, 1, 10 * MILLION, 25, 5, 40 * s, 0);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingIndep, L=1200, r=25");+      }+      sstring_DeleteRes (res);+   }+   {+      sstring_Res3 *res;+      res = sstring_CreateRes3 ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_Run (gen, res, 1, 2*BILLION, r, 3);+         bbattery_pVal[++j] = res->NRuns->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of bits, r = 0");+         bbattery_pVal[++j] = res->NBits->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of bits, r = 0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_Run (gen, res, 1, 2*BILLION, 27, 3);+         bbattery_pVal[++j] = res->NRuns->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of bits, r = 27");+         bbattery_pVal[++j] = res->NBits->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of bits, r = 27");+      }+      sstring_DeleteRes3 (res);+   }+   {+      sres_Basic *res;+      res = sres_CreateBasic ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_AutoCor (gen, res, 10, 30 + BILLION, r, 3, 1);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AutoCor, d=1, r=0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_AutoCor (gen, res, 10, 30 + BILLION, r, 3, 3);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AutoCor, d=3, r=0");+      }++      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_AutoCor (gen, res, 10, 30 + BILLION, 27, 3, 1);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AutoCor, d=1, r=27");+      }++      ++j2;+      util_Assert (j2 <= BIGCRUSH_NUM, "BigCrush:   j2 > BIGCRUSH_NUM");+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_AutoCor (gen, res, 10, 30 + BILLION, 27, 3, 3);+         bbattery_pVal[++j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AutoCor, d=3, r=27");+      }+      sres_DeleteBasic (res);+   }++   bbattery_NTests = ++j;+   GetName (gen, genName);+   chrono_Delete (Timer);+   return wrap(bbattery_pVal, bbattery_NTests);+}+++/*=========================================================================*/++BatteryResult* bbattery_BigCrush (unif01_Gen * gen)+{+   int i;+   int Rep[NDIM + 1] = {0};+   for (i = 1; i <= BIGCRUSH_NUM; ++i)+      Rep[i] = 1;+   return BigCrush (gen, Rep);+}+++/*=========================================================================*/++void bbattery_RepeatBigCrush (unif01_Gen * gen, int Rep[])+{+   BigCrush (gen, Rep);+}+++/*=========================================================================*/+#if 0+static void WriteTime (time_t t0, time_t t1)+{+   int y1;+   double y = 0;++   y = difftime (t1, t0);+   /* printf (" Total time: %.2f sec\n\n", y); */+   printf (" Total time: ");+   y1 = y / 3600;+   printf ("%02d:", y1);+   y -= y1 * 3600.0;+   y1 = y / 60;+   printf ("%02d:", y1);+   y -= y1 * 60.0;+   printf ("%.2f\n\n", y);+}+#endif++/*-------------------------------------------------------------------------*/++static void Alphabit (unif01_Gen * gen, char *fname, double nb, int r, int s,+   lebool blocFlag, int w, int Rep[])+{+   chrono_Chrono *Timer;+ /*  time_t t0, t1; */+   int NbDelta = 1;+   double ValDelta[] = { 1 };+   long N = 1;+   long n, L;+   int j = 0;+   int j2 = 0;+   int i;+   lebool fileFlag;+   long bufsiz;+   char genName[LEN + 1] = "";+   double z;+   unif01_Gen *gen0;++   Timer = chrono_Create ();+ /*  t0 = time (NULL); */+   InitBat ();+   if (swrite_Basic) {+      printf ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n"+         "          Starting Alphabit:   nb = %.0f\n"+         "          Version: %s\n"+         "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n\n\n",+         nb, PACKAGE_STRING);+   }+   util_Assert (nb > 0, "Alphabit:   nb <= 0");+   /* Bits will be read as 32-bit unsigned integers */+   nb -= fmod (nb, 32.0);+   bufsiz = nb / 32.0;++   if (blocFlag) {+      gen0 = ufile_CreateReadBin (fname, bufsiz);+      gen = unif01_CreateBitBlockGen (gen0, r, s, w);+      nb -= fmod (nb, 1024.0 / w);+      fileFlag = TRUE;+   } else if (NULL == gen) {+      gen = ufile_CreateReadBin (fname, bufsiz);+      fileFlag = TRUE;+   } else {+      fileFlag = FALSE;+   }++   {+      smultin_Param *par = NULL;+      smultin_Res *res;+      par = smultin_CreateParam (NbDelta, ValDelta, smultin_GenerCellSerial,+         3);+      res = smultin_CreateRes (par);+      if (fileFlag)+         ufile_InitReadBin ();++      if (nb > BILLION)+         N = 1 + nb / BILLION;+      else+         N = 1;+      n = nb / N;+      /* Set n as a multiple of s = 32 */+      n -= n % 32;+      j = -1;+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smultin_MultinomialBitsOver (gen, par, res, N, n, r, s, 2, FALSE);+         strcpy (bbattery_TestNames[++j], "MultinomialBitsOver, L = 2");+         if (N == 1)+            bbattery_pVal[j] = res->pVal2[0][gofw_Mean];+         else+            bbattery_pVal[j] = res->pVal2[0][gofw_AD];+         TestNumber[j] = j2;+      }++      if (fileFlag)+         ufile_InitReadBin ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         smultin_MultinomialBitsOver (gen, par, res, N, n, r, s, 4, FALSE);+         strcpy (bbattery_TestNames[++j], "MultinomialBitsOver, L = 4");+         if (N == 1)+            bbattery_pVal[j] = res->pVal2[0][gofw_Mean];+         else+            bbattery_pVal[j] = res->pVal2[0][gofw_AD];+         TestNumber[j] = j2;+      }++      ++j2;+      if (n > 250) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            smultin_MultinomialBitsOver (gen, par, res, N, n, r, s, 8, FALSE);+            strcpy (bbattery_TestNames[++j], "MultinomialBitsOver, L = 8");+            if (N == 1)+               bbattery_pVal[j] = res->pVal2[0][gofw_Mean];+            else+               bbattery_pVal[j] = res->pVal2[0][gofw_AD];+           TestNumber[j] = j2;+         }+      }++      ++j2;+      if (n > 65000) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            smultin_MultinomialBitsOver (gen, par, res, N, n, r, s, 16, FALSE);+            strcpy (bbattery_TestNames[++j], "MultinomialBitsOver, L = 16");+            if (N == 1)+               bbattery_pVal[j] = res->pVal2[0][gofw_Mean];+            else+               bbattery_pVal[j] = res->pVal2[0][gofw_AD];+           TestNumber[j] = j2;+         }+      }++      smultin_DeleteRes (res);+      smultin_DeleteParam (par);+   }++   {+      sstring_Res *res;+      res = sstring_CreateRes ();++      if (fileFlag)+         ufile_InitReadBin ();+      z = nb / s;+      N = 1 + z / BILLION;+      n = z / N;+      ++j2;+      if (n >= 20) {+         for (i = 0; i < Rep[j2]; ++i) {+            sstring_HammingIndep (gen, res, N, n, r, s, 16, 0);+            j++;+            if (N == 1)+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Mean];+            else+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Sum];+            strcpy (bbattery_TestNames[j], "HammingIndep, L = 16");+            TestNumber[j] = j2;+         }+      }++      if (fileFlag)+         ufile_InitReadBin ();+      n /= 2;+      ++j2;+      if (n >= 20) {+         for (i = 0; i < Rep[j2]; ++i) {+            sstring_HammingIndep (gen, res, N, n, r, s, 32, 0);+            j++;+            if (N == 1)+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Mean];+            else+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Sum];+            strcpy (bbattery_TestNames[j], "HammingIndep, L = 32");+            TestNumber[j] = j2;+         }+      }++      if (fileFlag)+         ufile_InitReadBin ();+      n *= 2;+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_HammingCorr (gen, res, N, n, r, s, 32);+         j++;+         if (N == 1)+            bbattery_pVal[j] = res->Bas->pVal2[gofw_Mean];+         else+            bbattery_pVal[j] = res->Bas->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "HammingCorr, L = 32");+      }+   }++   {+      swalk_Res *res;+      res = swalk_CreateRes ();++      if (fileFlag)+         ufile_InitReadBin ();+      L = 64;+      z = nb / L;+      N = 1 + z / BILLION;+      n = z / N;+      j2++;+      if (n >= 30) {+         for (i = 0; i < Rep[j2]; ++i) {+            swalk_RandomWalk1 (gen, res, N, n, r, s, L, L);+            GetPVal_Walk (N, res, &j, " (L = 64)", j2);+         }+      }++      if (fileFlag)+         ufile_InitReadBin ();+      L = 320;+      z = nb / L;+      N = 1 + z / BILLION;+      n = z / N;+      j2++;+      util_Assert (j2 <= ALPHABIT_NUM, "Alphabit:   j2 > ALPHABIT_NUM");+      if (n >= 30) {+         for (i = 0; i < Rep[j2]; ++i) {+            swalk_RandomWalk1 (gen, res, N, n, r, s, L, L);+            GetPVal_Walk (N, res, &j, " (L = 320)", j2);+         }+      }+      swalk_DeleteRes (res);+   }++   bbattery_NTests = ++j;+   if (blocFlag) {+      unif01_DeleteBitBlockGen (gen);+      gen = gen0;+   }+   if (fileFlag) {+      WriteReport (fname, "Alphabit", bbattery_NTests,+         bbattery_pVal, Timer, TRUE, TRUE, nb);+      ufile_DeleteReadBin (gen);+   } else {+      GetName (gen, genName);+      WriteReport (genName, "Alphabit", bbattery_NTests, bbattery_pVal,+         Timer, FALSE, TRUE, nb);+   }++   chrono_Delete (Timer);+  /*  t1 = time (NULL);+    WriteTime (t0, t1); */+}+++/*=========================================================================*/++void bbattery_Alphabit (unif01_Gen * gen, double nb, int r, int s)+{+   int i;+   int Rep[NDIM + 1] = {0};+   for (i = 1; i <= ALPHABIT_NUM; ++i)+      Rep[i] = 1;+   Alphabit (gen, NULL, nb, r, s, FALSE, 0, Rep);+}+++/*=========================================================================*/++void bbattery_AlphabitFile (char *filename, double nb)+{+   int i;+   int Rep[NDIM + 1] = {0};+   for (i = 1; i <= ALPHABIT_NUM; ++i)+      Rep[i] = 1;+   Alphabit (NULL, filename, nb, 0, 32, FALSE, 0, Rep);+}+++/*=========================================================================*/++void bbattery_RepeatAlphabit (unif01_Gen * gen, double nb, int r, int s,+   int Rep[])+{+   Alphabit (gen, NULL, nb, r, s, FALSE, 0, Rep);+}+++/*=========================================================================*/++void bbattery_BlockAlphabit (unif01_Gen * gen, double n, int r, int s)+{+   unif01_Gen *gen2;+   int L = 1;+   int i;+   int Rep[NDIM + 1] = {0};+   for (i = 1; i <= ALPHABIT_NUM; ++i)+      Rep[i] = 1;+   while ((L <= 32) && (L <= s)) {+      gen2 = unif01_CreateBitBlockGen (gen, r, s, L);+      Alphabit (gen2, NULL, n, r, s, FALSE, 0, Rep);+      unif01_DeleteBitBlockGen (gen2);+      L *= 2;+   }+}+++/*=========================================================================*/++void bbattery_RepeatBlockAlphabit (unif01_Gen * gen, double nb, int r, int s,+   int Rep[], int L)+{+   if ((L <= 32) && (L <= s)) {+      unif01_Gen *gen2;+      gen2 = unif01_CreateBitBlockGen (gen, r, s, L);+      Alphabit (gen2, NULL, nb, r, s, FALSE, 0, Rep);+      unif01_DeleteBitBlockGen (gen2);+   }+}+++/*=========================================================================*/++void bbattery_BlockAlphabitFile (char *filename, double nb)+{+   int w = 1;+   int i;+   int Rep[NDIM + 1] = {0};+   for (i = 1; i <= ALPHABIT_NUM; ++i)+      Rep[i] = 1;+   while (w <= 32) {+      Alphabit (NULL, filename, nb, 0, 32, TRUE, w, Rep);+      w *= 2;+   }+}+++/*=========================================================================*/++static void DoMultinom (lebool fileFlag, /* */+   unif01_Gen * gen,              /* */+   double nb,                     /* Number of bits */+   int *pj,                       /* j */+   int j2,                        /* Test number in the battery */+   int Rep[]                      /* Number of replications */+   )+/*+ * Do the smultin_MultinomialBits in Rabbit+ */+{+   const long NLIM = 10000000;+   long n, N;+   int L, t;+   double x;+   int i;+   int j = *pj;+   smultin_Res *res;+   smultin_Param *par = NULL;+   double ValDelta[] = { -1 };++   util_Assert (nb > 0.0, "MultinomialBits:   nb <= 0");+   par = smultin_CreateParam (1, ValDelta, smultin_GenerCellSerial, -3);+   res = smultin_CreateRes (par);+   if (fileFlag)+      ufile_InitReadBin ();++#ifdef USE_LONGLONG+   /* Limit sample size n to NLIM because of memory limitations. */+   /* Determine number of replications N from this. */+   N = 1 + nb / NLIM;+   n = nb / N;+   /* Time limit on test: N = 30 */+   N = util_Min (30, N);+   /* Set n as a multiple of s = 32 */+   n -= n % 32;+   L = num_Log2 (n / 200.0 * n);+   L = util_Max (4, L);+   for (i = 0; i < Rep[j2]; ++i) {+      smultin_MultinomialBitsOver (gen, par, res, N, n, 0, 32, L, TRUE);+      strcpy (bbattery_TestNames[++j], "MultinomialBitsOver");+      bbattery_pVal[j] = res->pColl;+      TestNumber[j] = j2;+   }++#else+   x = nb / 32.0;+   N = 1 + x / NLIM;+   n = x / N;+   N = util_Min (30, N);+   L = 16;+   t = 32 / L;+   /* We want a number of collisions >= 2 */+   while ((L > 1) && (n / num_TwoExp[L] * n * t * t < 2.0)) {+      L /= 2;+      t = 32 / L;+   }+   n = n * (32 / L);+   /* We want a density n / k < 2 to use case Sparse = TRUE */+   if (n > 2 * num_TwoExp[L]) {+      N = n / num_TwoExp[L] * N;+      n /= N;+      while ((double) N * n * L > nb)+         n--;+   }+   while (n * L % 32 > 0)+      n--;+   if (n > 3) {+      for (i = 0; i < Rep[j2]; ++i) {+         smultin_MultinomialBits (gen, par, res, N, n, 0, 32, L, TRUE);+         strcpy (bbattery_TestNames[++j], "MultinomialBits");+         bbattery_pVal[j] = res->pColl;+         TestNumber[j] = j2;+      }+   }+#endif+   *pj = j;+   smultin_DeleteRes (res);+   smultin_DeleteParam (par);+}+++/*-------------------------------------------------------------------------*/++static void DoAppear (lebool fileFlag, /* */+   unif01_Gen * gen, double nb,   /* Number of bits to test */+   int *pj,                       /* j */+   int j2,                        /* Test number in the battery */+   int Rep[]+   )+/*+ * Do the svaria_AppearanceSpacings test in Rabbit+ */+{+   sres_Basic *res;+   const long NLIM = 2000000000;+   int L;+   long N, Q;+   int i;+   int j = *pj;+   double temp = nb * (30.0 / 32.0) / 20.0;++   res = sres_CreateBasic ();+   if (num_TwoExp[30] < temp / 30.0)+      L = 30;+   else if (num_TwoExp[15] < temp / 15.0)+      L = 15;+   else if (num_TwoExp[10] < temp / 10.0)+      L = 10;+   else if (num_TwoExp[6] < temp / 6.0)+      L = 6;+   else if (num_TwoExp[5] < temp / 5.0)+      L = 5;+   else if (num_TwoExp[3] < temp / 3.0)+      L = 3;+   else+      L = 2;+   temp = nb / 2;+   temp *= 30.0 / 32.0;+   temp /= L;+   N = 1 + temp / NLIM;+   Q = temp / N;+   N = 1;++   if (Q < 50)+      return;+   if (fileFlag)+      ufile_InitReadBin ();+   for (i = 0; i < Rep[j2]; ++i) {+      svaria_AppearanceSpacings (gen, res, N, Q, Q, 0, 30, L);+      j++;+      if (N == 1)+         bbattery_pVal[j] = res->pVal2[gofw_Mean];+      else+         bbattery_pVal[j] = res->pVal2[gofw_Sum];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "AppearanceSpacings");+   }+   sres_DeleteBasic (res);+   *pj = j;+}+++/*-------------------------------------------------------------------------*/++static void DoWalk (lebool fileFlag, /* */+   unif01_Gen * gen,              /* */+   double nb,                     /* Number of bits to test */+   int *pj,                       /* j */+   int j2,                        /* Test number in the battery */+   int Rep[]+   )+/*+ * Do 3 swalk_RandomWalk1 tests in Rabbit+ */+{+   swalk_Res *res;+   long n, N, L;+   double z;+   int i;++   L = 128;+   z = nb / L;+   N = 1 + z / BILLION;+   n = z / N;+   N = 1;+   while (n < 100) {+      L /= 2;+      n *= 2;+   }+   if (L < 4)+      return;+   n = nb / (L * N);+   n = util_Min (n, 500 * MILLION);+   if (L < 32) {+      while (32 * n > nb)+         n--;+   }+   if (n < 30)+      return;++   res = swalk_CreateRes ();+   ++j2;+   if (fileFlag)+      ufile_InitReadBin ();+   for (i = 0; i < Rep[j2]; ++i) {+      swalk_RandomWalk1 (gen, res, N, n, 0, 32, L, L);+      GetPVal_Walk (N, res, pj, "", j2);+   }+   if (L < 96)+      return;++   L = 1024;+   z = nb / L;+   N = 1 + z / BILLION;+   n = z / N;+   n = util_Min (n, 50 * MILLION);+   N = 1;+   while ((double) n * L > nb)+      n--;+   if (n < 30)+      return;++   ++j2;+   if (fileFlag)+      ufile_InitReadBin ();+   for (i = 0; i < Rep[j2]; ++i) {+      swalk_RandomWalk1 (gen, res, N, n, 0, 32, L, L);+      GetPVal_Walk (N, res, pj, " (L = 1024)", j2);+   }++   L = 10016;+   z = nb / L;+   N = 1 + z / BILLION;+   n = z / N;+   n = util_Min (n, 5 * MILLION);+   N = 1;+   while ((double) n * L > nb)+      n--;+   if (n < 30)+      return;+   ++j2;+   if (fileFlag)+      ufile_InitReadBin ();+   for (i = 0; i < Rep[j2]; ++i) {+      swalk_RandomWalk1 (gen, res, N, n, 0, 32, L, L);+      GetPVal_Walk (N, res, pj, " (L = 10016)", j2);+   }++   swalk_DeleteRes (res);+}+++/*-------------------------------------------------------------------------*/++static void Rabbit (unif01_Gen * gen, char *fname, double nb, int Rep[])+/*+ * A battery of statistical tests for a file of n random bits.+ */+{+   const int s = 32;+   int k, j = 0, j2 = 0;+   int i;+   long n, N, L;+   double nw, x;+   chrono_Chrono *Timer;+   long bufsiz;+   lebool fileFlag;+   char genName[LEN + 1] = "";++   Timer = chrono_Create ();+   InitBat ();+   if (swrite_Basic) {+      printf ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n"+         "          Starting Rabbit:   nb = %.0f\n"+         "          Version: %s\n"+         "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n\n\n",+         nb, PACKAGE_STRING);+   }+   util_Assert (nb >= 500.0, "bbattery_Rabbit:   nb < 500");++   /* Bits will be read as 32-bit unsigned integers */+   nb -= fmod (nb, 32.0);+   nw = nb / 32.0;+   bufsiz = nw;++   if (NULL == gen) {+      gen = ufile_CreateReadBin (fname, bufsiz);+      fileFlag = TRUE;+   } else+      fileFlag = FALSE;++   j = -1;+   ++j2;+   DoMultinom (fileFlag, gen, nb, &j, j2, Rep);++   {+      const long NLIM = 4000000;+      snpair_Res *res;+      res = snpair_CreateRes ();+      N = 1 + nw / NLIM;+      n = nw / N;+      N = util_Min (N, 25);+      if (fileFlag)+         ufile_InitReadBin ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairsBitMatch (gen, res, N, n / 2, 0, 2);+         bbattery_pVal[++j] = res->pVal[snpair_BM];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "ClosePairsBitMatch, t = 2");+      }++      if (fileFlag)+         ufile_InitReadBin ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         snpair_ClosePairsBitMatch (gen, res, N, n / 4, 0, 4);+         bbattery_pVal[++j] = res->pVal[snpair_BM];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "ClosePairsBitMatch, t = 4");+      }+      snpair_DeleteRes (res);+   }++   ++j2;+   DoAppear (fileFlag, gen, nb, &j, j2, Rep);++   {+      const long NLIM1 = 300000;+      const long NLIM2 = 10000;+      scomp_Res *res;+      res = scomp_CreateRes ();+      n = NLIM2 + 2.0 * sqrt (nb);+      n = util_Min (n, nb);+      n = util_Min (n, NLIM1);+      N = 1;+      if (fileFlag)+         ufile_InitReadBin ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         scomp_LinearComp (gen, res, N, n, 0, s);+         j++;+         if (N == 1)+            bbattery_pVal[j] = res->JumpSize->pVal2[gofw_Mean];+         else+            bbattery_pVal[j] = res->JumpSize->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LinearComp");+         j++;+         if (N == 1)+            bbattery_pVal[j] = res->JumpNum->pVal2[gofw_Mean];+         else+            bbattery_pVal[j] = res->JumpNum->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LinearComp");+      }+      scomp_DeleteRes (res);+   }++   k = num_Log2 (nb + 0.5);+   if (k > 28)+      k = 28;+   N = 1;+   {+      sres_Basic *res;+      res = sres_CreateBasic ();+      if (fileFlag)+         ufile_InitReadBin ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         scomp_LempelZiv (gen, res, N, k, 0, s);+         j++;+         if (N == 1)+            bbattery_pVal[j] = res->pVal2[gofw_Mean];+         else+            bbattery_pVal[j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "LempelZiv");+      }+      sres_DeleteBasic (res);+   }+   {+      sspectral_Res *res;+      k = num_Log2 (nb + 0.5);+      k = util_Min (20, k);+      res = sspectral_CreateRes ();+      if (fileFlag)+         ufile_InitReadBin ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sspectral_Fourier1 (gen, res, 1, k, 0, s);+         j++;+         bbattery_pVal[j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Fourier1");+      }++      x = sqrt (2.0 * nb);+      N = x / 2.0;+      if (N < 32) {+         k = 5;+         N = nb / 32.0;+      } else if (N >= 16384) {+         k = 14;+         N = nb / 16384.0;+      } else {+         k = num_Log2 (x / 2.0 + 0.5);+         N = nb / (num_TwoExp[k]);+      }+      N = util_Min (N, 300000);+      while ((num_TwoExp[k] + 32) * N > nb)+         N--;+      if (fileFlag)+         ufile_InitReadBin ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sspectral_Fourier3 (gen, res, N, k, 0, s);+         j++;+         bbattery_pVal[j] = res->Bas->pVal2[gofw_AD];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Fourier3");+      }+      sspectral_DeleteRes (res);+   }+   {+      sstring_Res2 *res;+      res = sstring_CreateRes2 ();+      x = util_Min (BILLION * 100.0, nb);+      n = 600;+      L = x / n;+      if (L <= 100000) {+         n /= 10;+         L *= 10;+      }+      if (L <= 10000) {+         n /= 2;+         L *= 2;+      }+      ++j2;+      if ((L >= 1032) && (n >= 30)) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            sstring_LongestHeadRun (gen, res, 1, n, 0, s, L);+            j++;+            bbattery_pVal[j] = res->Chi->pVal2[gofw_Mean];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "LongestHeadRun");+         }+      }+      sstring_DeleteRes2 (res);+   }+   {+      sres_Chi2 *res;+      res = sres_CreateChi2 ();+      nw = nb / 32.0;+      nw = util_Min (nw, 4.0 * BILLION);+      N = 1 + nw / BILLION;+      n = nw / N;+      ++j2;+      if (n >= 30) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            sstring_PeriodsInStrings (gen, res, N, n, 0, 31);+            ++j;+            if (N == 1)+               bbattery_pVal[j] = res->pVal2[gofw_Mean];+            else+               bbattery_pVal[j] = res->pVal2[gofw_Sum];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "PeriodsInStrings");+         }+      }++      nw = nb / s;+      N = 1 + nw / BILLION;+      n = nw / N;+      N = util_Min (10, N);+      ++j2;+      if (n > 29) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            sstring_HammingWeight (gen, res, N, n, 0, s, s);+            ++j;+            if (N == 1)+               bbattery_pVal[j] = res->pVal2[gofw_Mean];+            else+               bbattery_pVal[j] = res->pVal2[gofw_Sum];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "HammingWeight");+         }+      }+      sres_DeleteChi2 (res);+   }+   {+      sstring_Res *res;+      res = sstring_CreateRes ();+      nw = nb / s;+      N = 1 + nw / BILLION;+      n = nw / N;+      N = util_Min (10, N);+      ++j2;+      if (n > 2) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            j++;+            sstring_HammingCorr (gen, res, N, n, 0, s, 32);+            if (N == 1)+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Mean];+            else+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Sum];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "HammingCorr, L = 32");+         }+      }++      nw = nb / 64;+      N = 1 + nw / BILLION;+      n = nw / N;+      N = 1;+      ++j2;+      if (n > 2) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            j++;+            sstring_HammingCorr (gen, res, N, n, 0, s, 2 * s);+            if (N == 1)+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Mean];+            else+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Sum];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "HammingCorr, L = 64");+         }+      }++      nw = nb / (4 * s);+      N = 1 + nw / BILLION * 4;+      n = nw / N;+      N = 1;+      ++j2;+      if (n > 2) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            sstring_HammingCorr (gen, res, N, n, 0, s, 4 * s);+            j++;+            if (N == 1)+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Mean];+            else+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Sum];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "HammingCorr, L = 128");+         }+      }++      nw = nb / s;+      N = 1 + nw / BILLION;+      n = nw / N;+      N = util_Min (5, N);+      ++j2;+      if (n > 29) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            j++;+            sstring_HammingIndep (gen, res, N, n, 0, s, 16, 0);+            if (N == 1)+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Mean];+            else+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Sum];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "HammingIndep, L = 16");+         }+      }++      nw = nb / (2 * s);+      N = 1 + nw / BILLION * 2;+      n = nw / N;+      N = 1;+      ++j2;+      if (n > 29) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            j++;+            sstring_HammingIndep (gen, res, N, n, 0, s, s, 0);+            if (N == 1)+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Mean];+            else+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Sum];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "HammingIndep, L = 32");+         }+      }++      nw = nb / (4 * s);+      N = 1 + nw / BILLION * 10;+      n = nw / N;+      N = 1;+      ++j2;+      if (n > 29) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            j++;+            sstring_HammingIndep (gen, res, N, n, 0, s, 2 * s, 0);+            if (N == 1)+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Mean];+            else+               bbattery_pVal[j] = res->Bas->pVal2[gofw_Sum];+            strcpy (bbattery_TestNames[j], "HammingIndep, L = 64");+            TestNumber[j] = j2;+         }+      }+      sstring_DeleteRes (res);+   }+   {+      sres_Basic *res;+      int d;+      res = sres_CreateBasic ();++      d = 1;+      N = 1 + nb / BILLION;+      n = nb / N - d;+      n -= n % 32;+      N = util_Min (100, N);+      if (fileFlag)+         ufile_InitReadBin ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_AutoCor (gen, res, N, n, 0, s, d);+         j++;+         if (N == 1)+            bbattery_pVal[j] = res->pVal2[gofw_Mean];+         else+            bbattery_pVal[j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AutoCor");+      }++      d = 2;+      N = 1 + nb / BILLION;+      n = nb / N - d;+      n -= n % 32;+      N = util_Min (100, N);+      if (fileFlag)+         ufile_InitReadBin ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_AutoCor (gen, res, N, n, 0, s, d);+         j++;+         if (N == 1)+            bbattery_pVal[j] = res->pVal2[gofw_Mean];+         else+            bbattery_pVal[j] = res->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "AutoCor");+      }++      sres_DeleteBasic (res);+   }+   {+      sstring_Res3 *res;+      res = sstring_CreateRes3 ();+      nw = nb / 5;+      N = 1 + nw / BILLION;+      n = nw / N;+      N = util_Min (20, N);+      if (fileFlag)+         ufile_InitReadBin ();+      ++j2;+      for (i = 0; i < Rep[j2]; ++i) {+         sstring_Run (gen, res, N, n, 0, s);+         j++;+         if (N == 1)+            bbattery_pVal[j] = res->NRuns->pVal2[gofw_Mean];+         else+            bbattery_pVal[j] = res->NRuns->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of bits");+         j++;+         if (N == 1)+            bbattery_pVal[j] = res->NBits->pVal2[gofw_Mean];+         else+            bbattery_pVal[j] = res->NBits->pVal2[gofw_Sum];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "Run of bits");+       }+      sstring_DeleteRes3 (res);+   }++   {+      sres_Chi2 *res;+      res = sres_CreateChi2 ();+      n = nb / (s * s);+      n = util_Min (n, 50 * MILLION);+      ++j2;+      if (n >= 50) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            j++;+            smarsa_MatrixRank (gen, res, 1, n, 0, s, s, s);+            bbattery_pVal[j] = res->pVal2[gofw_Mean];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "MatrixRank, 32 x 32");+         }+      }++      n = nb / (100.0 * s * s);+      n = util_Min (n, 300000);+      ++j2;+      if (n >= 50) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            j++;+            smarsa_MatrixRank (gen, res, 1, n, 0, s, 10 * s, 10 * s);+            bbattery_pVal[j] = res->pVal2[gofw_Mean];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "MatrixRank, 320 x 320");+         }+      }++      n = nb / (1024.0 * s * s);+      n = util_Min (n, 20000);+      ++j2;+      if (n >= 50) {+         if (fileFlag)+            ufile_InitReadBin ();+         for (i = 0; i < Rep[j2]; ++i) {+            j++;+            smarsa_MatrixRank (gen, res, 1, n, 0, s, 32 * s, 32 * s);+            bbattery_pVal[j] = res->pVal2[gofw_Mean];+            TestNumber[j] = j2;+            strcpy (bbattery_TestNames[j], "MatrixRank, 1024 x 1024");+         }+      }+      sres_DeleteChi2 (res);+   }++   DoWalk (fileFlag, gen, nb, &j, j2, Rep);+   util_Assert (j2 <= RABBIT_NUM, "Rabbit:   j2 > RABBIT_NUM");++   bbattery_NTests = ++j;+   if (fileFlag) {+      WriteReport (fname, "Rabbit", bbattery_NTests,+         bbattery_pVal, Timer, TRUE, TRUE, nb);+      ufile_DeleteReadBin (gen);+   } else {+      GetName (gen, genName);+      WriteReport (genName, "Rabbit", bbattery_NTests, bbattery_pVal,+         Timer, FALSE, TRUE, nb);+   }+   chrono_Delete (Timer);+}+++/*=========================================================================*/++void bbattery_Rabbit (unif01_Gen * gen, double nb)+{+   int i;+   int Rep[NDIM + 1] = {0};+   for (i = 1; i <= RABBIT_NUM; ++i)+      Rep[i] = 1;+   Rabbit (gen, NULL, nb, Rep);+}+++/*=========================================================================*/++void bbattery_RabbitFile (char *filename, double nb)+{+   int i;+   int Rep[NDIM + 1] = {0};+   for (i = 1; i <= RABBIT_NUM; ++i)+      Rep[i] = 1;+   Rabbit (NULL, filename, nb, Rep);+}+++/*=========================================================================*/++void bbattery_RepeatRabbit (unif01_Gen * gen, double nb, int Rep[])+{+   Rabbit (gen, NULL, nb, Rep);+}+++/*=========================================================================*/++BatteryResult* bbattery_pseudoDIEHARD (unif01_Gen * gen)+/*+ * As close as possible to the DIEHARD test suite.+ */+{+   chrono_Chrono *Timer;+   smultin_Param *par = NULL;+   double ValDelta[] = { 1 };+   char genName[LEN + 1] = "";+   int k, i, j = -1;+   int j2 = 0;+   double x;+   long Count[7];+   double NumExp[7] = {+      67.668, 135.335, 135.335, 90.224, 45.112, 18.045, 8.282+   };+   swrite_Basic = 0;++   Timer = chrono_Create ();+   InitBat ();+   if (swrite_Basic) {+      printf ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n"+         "                 Starting pseudoDIEHARD\n"+         "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n\n\n");+   }+   {+      sres_Poisson *res;+      sres_Chi2 *Chi;+      Chi = sres_CreateChi2 ();+      sres_InitChi2 (Chi, 1, 6, "");+      res = sres_CreatePoisson ();+      printf ("smarsa_BirthdaySpacings test with r = 0, 1, 2, 3, 4, 5,"+         " 6, 7, 8,\n .....\n\n");+      swrite_Basic = FALSE;+      ++j2;+      for (i = 0; i <= 8; i++) {+         printf (" r = %d\n", i);+         for (k = 0; k <= 6; k++)+            Count[k] = 0;+         for (k = 0; k < 500; k++) {+            smarsa_BirthdaySpacings (gen, res, 1, 512, i, 16777216, 1, 1);+            if (res->sVal2 >= 6)+               ++Count[6];+            else+               ++Count[(int) res->sVal2];+         }+         x = gofs_Chi2 (NumExp, Count, 0, 6);+         printf ("ChiSquare statistic                   :");+         bbattery_pVal[++j] = fbar_ChiSquare2 (6, 12, x);+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "BirthdaySpacings");+         gofw_Writep2 (x, bbattery_pVal[j]);+      }+      printf ("\n\n\n\n");+      sres_DeletePoisson (res);+      sres_DeleteChi2 (Chi);+      swrite_Basic = TRUE;+   }+   ++j2;+   {+      sres_Chi2 *res;+      res = sres_CreateChi2 ();+      smarsa_MatrixRank (gen, res, 1, 40000, 0, 31, 31, 31);+      bbattery_pVal[++j] = res->pVal2[gofw_Mean];+      TestNumber[j] = ++j2;+      strcpy (bbattery_TestNames[j], "MatrixRank");++      smarsa_MatrixRank (gen, res, 1, 40000, 0, 32, 32, 32);+      bbattery_pVal[++j] = res->pVal2[gofw_Mean];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "MatrixRank");++      for (i = 0; i <= 24; i++) {+         smarsa_MatrixRank (gen, res, 1, 100000, i, 8, 6, 8);+         bbattery_pVal[++j] = res->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "MatrixRank");+      }+      sres_DeleteChi2 (res);+   }+   {+      smultin_Res *res;+      par = smultin_CreateParam (1, ValDelta, smultin_GenerCellSerial, 0);+      res = smultin_CreateRes (par);+      smultin_MultinomialBitsOver (gen, par, res, 20, 2097152, 0, 32, 20,+         TRUE);+      bbattery_pVal[++j] = res->pVal2[0][gofw_AD];+      TestNumber[j] = ++j2;+      strcpy (bbattery_TestNames[j], "MultinomialBitsOver");+      smultin_DeleteRes (res);+      smultin_DeleteParam (par);+   }+   {+      smarsa_Res *res;+      res = smarsa_CreateRes ();+      ++j2;+      for (i = 22; i >= 0; i--) {+         smarsa_Opso (gen, res, 1, i, 1);+         bbattery_pVal[++j] = res->Pois->pVal2;+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "OPSO");+      }+      ValDelta[0] = -1.0;+      ++j2;+      for (i = 27; i >= 0; i--) {+         if (swrite_Basic)+            printf ("***********************************************************\n"+               "Test OQSO calling smarsa_CollisionOver\n\n");+         smarsa_CollisionOver (gen, res, 1, 2097152, i, 32, 4);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "OQSO");+      }+      ++j2;+      for (i = 30; i >= 0; i--) {+         if (swrite_Basic)+            printf ("***********************************************************\n"+               "Test DNA calling smarsa_CollisionOver\n\n");+         smarsa_CollisionOver (gen, res, 1, 2097152, i, 4, 10);+         bbattery_pVal[++j] = res->Bas->pVal2[gofw_Mean];+         TestNumber[j] = j2;+         strcpy (bbattery_TestNames[j], "DNA");+      }+      smarsa_DeleteRes (res);+   }+   j2 += 2;+   {+      snpair_Res *res;+      res = snpair_CreateRes ();+      snpair_ClosePairs (gen, res, 100, 8000, 0, 2, 2, 1);+      bbattery_pVal[++j] = res->pVal[snpair_NP];+      TestNumber[j] = ++j2;+      strcpy (bbattery_TestNames[j], "ClosePairs");++      snpair_ClosePairs (gen, res, 20, 4000, 0, 3, 2, 1);+      bbattery_pVal[++j] = res->pVal[snpair_NP];+      TestNumber[j] = ++j2;+      strcpy (bbattery_TestNames[j], "ClosePairs");+      snpair_DeleteRes (res);+   }+   {+      sres_Chi2 *res;+      res = sres_CreateChi2 ();+      smarsa_Savir2 (gen, res, 1, 100000, 0, 90000, 18);+      bbattery_pVal[++j] = res->pVal2[gofw_Mean];+      TestNumber[j] = ++j2;+      strcpy (bbattery_TestNames[j], "Savir2");++      ++j2;+      sknuth_Run (gen, res, 10, 10000, 0, TRUE);+      bbattery_pVal[++j] = res->pVal2[gofw_Sum];+      TestNumber[j] = ++j2;+      strcpy (bbattery_TestNames[j], "Run of U01");++      sknuth_Run (gen, res, 10, 10000, 0, FALSE);+      bbattery_pVal[++j] = res->pVal2[gofw_Sum];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "Run of U01");++      sknuth_Run (gen, res, 10, 10000, 0, TRUE);+      bbattery_pVal[++j] = res->pVal2[gofw_Sum];+      TestNumber[j] = j2;+      strcpy (bbattery_TestNames[j], "Run of U01");++      sknuth_Run (gen, res, 10, 10000, 0, FALSE);+      bbattery_pVal[++j] = res->pVal2[gofw_Sum];+      strcpy (bbattery_TestNames[j], "Run of U01");+      TestNumber[j] = j2;+      sres_DeleteChi2 (res);+   }++   bbattery_NTests = ++j;+   GetName (gen, genName);+   chrono_Delete (Timer);+   return wrap(bbattery_pVal, bbattery_NTests);+}+++/*=========================================================================*/++static double ProbabiliteLHR (long j, double Lnl)+/*+ * Returns the probability that the longest series of successive 1 has+ * length = j.+ */+{+   double x, temp;+   temp = (j + 1) * num_Ln2 - Lnl;+   x = exp (-exp (-temp));+   temp += num_Ln2;+   x = exp (-exp (-temp)) - x;+   return x;+}++/*-------------------------------------------------------------------------*/++static double GetPLongest (int longest)+/*+ * Get the probabilities for the longest run of 1 or 0 over 20000 bits.+ */+{+   double pLeft, pRight;+   double LnLen;+   int j;++   LnLen = log (20000.0);+   pLeft = 0.0;+   for (j = 0; j < longest; j++)+      pLeft += ProbabiliteLHR (j, LnLen);+   pRight = 1.0 - pLeft;+   pLeft += ProbabiliteLHR (longest, LnLen);+   return gofw_pDisc (pLeft, pRight);+}+++/*-------------------------------------------------------------------------*/++static void WriteReportFIPS_140_2 (+   char *genName,                 /* Generator or file name */+   lebool Flag,                  /* = TRUE for a file, FALSE for a gen */+   int nbit,                      /* Number of bits */+   int longest0,                  /* Longest string of 0 */+   int longest1,                  /* Longest string of 1 */+   int nrun0[],                   /* Number of 0 runs */+   int nrun1[],                   /* Number of 1 runs */+   int ncount[]                   /* Number of 4 bits values */+   )+{+   int i, j;+   double X;+   fmass_INFO Q;+   double p, pLeft, pRight;+   lebool failFlag = FALSE;++   printf+      ("\n============== Summary results of FIPS-140-2 ==============\n\n");+   if (Flag) {+      printf (" File:             ");+   } else {+      printf (" Generator:        ");+   }+   printf ("%s", genName);+   printf ("\n Number of bits:   20000\n");++   printf ("\n       Test          s-value        p-value    FIPS Decision\n");+   printf (" --------------------------------------------------------\n");++   /* Monobit results */+   j = 0;+   printf (" %-20s", bbattery_TestNames[j]);+   printf (" %5d       ", nbit);+   Q = fmass_CreateBinomial (20000, 0.5, 0.5);+   pLeft = fdist_Binomial2 (Q, nbit);+   pRight = fbar_Binomial2 (Q, nbit);+   fmass_DeleteBinomial (Q);+   p = gofw_pDisc (pLeft, pRight);+   gofw_Writep0 (p);+   if ((nbit <= 9725) || nbit >= 10275) {+      printf (" %10s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %10s", "Pass");++   printf ("\n");++   /* Poker results */+   X = 0;+   for (i = 0; i < 16; i++)+      X += (double) ncount[i] * ncount[i];+   X = 16 * X / 5000 - 5000;+   j = 1;+   printf (" %-16s", bbattery_TestNames[j]);+   printf ("%10.2f       ", X);+   p = fbar_ChiSquare2 (15, 12, X);+   gofw_Writep0 (p);+   if ((X <= 2.16) || X >= 46.17) {+      printf (" %10s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %10s", "Pass");+   printf ("\n\n");++   /* Run results */+   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun0[1]);+   if ((nrun0[1] <= 2315) || nrun0[1] >= 2685) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun0[2]);+   if ((nrun0[2] <= 1114) || nrun0[2] >= 1386) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun0[3]);+   if ((nrun0[3] <= 527) || nrun0[3] >= 723) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun0[4]);+   if ((nrun0[4] <= 240) || nrun0[4] >= 384) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun0[5]);+   if ((nrun0[5] <= 103) || nrun0[5] >= 209) {+      failFlag = TRUE;+      printf (" %25s", "Fail");+   } else+      printf (" %25s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun0[6]);+   if ((nrun0[6] <= 103) || nrun0[6] >= 209) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun1[1]);+   if ((nrun1[1] <= 2315) || nrun1[1] >= 2685) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun1[2]);+   if ((nrun1[2] <= 1114) || nrun1[2] >= 1386) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun1[3]);+   if ((nrun1[3] <= 527) || nrun1[3] >= 723) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun1[4]);+   if ((nrun1[4] <= 240) || nrun1[4] >= 384) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun1[5]);+   if ((nrun1[5] <= 103) || nrun1[5] >= 209) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d", nrun1[6]);+   if ((nrun1[6] <= 103) || nrun1[6] >= 209) {+      printf (" %25s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %25s", "Pass");+   printf ("\n\n");++   /* Longest run results */+   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d       ", longest0);+   p = GetPLongest (longest0);+   gofw_Writep0 (p);+   if (longest0 >= 26) {+      printf (" %10s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %10s", "Pass");+   printf ("\n");++   printf (" %-20s", bbattery_TestNames[++j]);+   printf (" %5d       ", longest1);+   p = GetPLongest (longest1);+   gofw_Writep0 (p);+   if (longest1 >= 26) {+      printf (" %10s", "Fail");+      failFlag = TRUE;+   } else+      printf (" %10s", "Pass");+   printf ("\n");++   if (!failFlag) {+      printf (" ----------------------------------------------------------\n");+      printf (" All values are within the required intervals of FIPS-140-2\n");+   }+   printf ("\n\n\n");+}+++/*-------------------------------------------------------------------------*/++#define SAMPLE 625                /* 625 * 32 = 20000 */+#define MASK4  15                 /* Mask of 4 bits */++static void FIPS_140_2 (unif01_Gen * gen, char *filename)+{+   int i, j;+   int nbit = 0;                  /* Number of bits */+   int longest0 = 0;              /* Longest string of 0 */+   int longest1 = 0;              /* Longest string of 1 */+   int nrun0[7] = { 0 };          /* Number of 0 runs */+   int nrun1[7] = { 0 };          /* Number of 1 runs */+   int ncount[16] = { 0 };        /* Number of 4 bits values */+   int prevBit;                   /* Previous bit */+   int len = 0;                   /* Length of run */+   unsigned long jBit;            /* Current bit */+   unsigned long Z;               /* Block of 32 bits */+   unsigned long Bits[SAMPLE + 1];+   lebool fileFlag = FALSE;+   char genName[LEN + 1] = "";++   InitBat ();+   if (swrite_Basic) {+      printf ("xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n"+         "                 Starting FIPS_140_2\n"+         "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n\n\n");+   }+   util_Assert (NULL == gen || NULL == filename,+      "bbattery_FIPS_140_2:   one of gen or filename must be NULL");+   util_Assert (!(NULL == gen && NULL == filename),+      "bbattery_FIPS_140_2:   no generator and no file");+   util_Assert (!(NULL == gen && !(strcmp (filename, ""))),+      "bbattery_FIPS_140_2:   no generator and no file");++   if ((NULL == gen) && filename && strcmp (filename, "")) {+      gen = ufile_CreateReadBin (filename, SAMPLE);+      fileFlag = TRUE;+   }++   for (j = 0; j < SAMPLE; j++)+      Bits[j] = unif01_StripB (gen, 0, 32);++   if (fileFlag) {+      ufile_DeleteReadBin (gen);+      strncpy (genName, filename, (size_t) LEN);+   } else {+      GetName (gen, genName);+   }++   /* Make sure to count the first run; set prevBit != {0, 1} */+   prevBit = 2;++   for (j = 0; j < SAMPLE; j++) {+      /* Count the number of 1 */+      Z = Bits[j];+      while (Z > 0) {+         Z &= Z - 1;              /* Clear lowest 1 bit */+         ++nbit;+      }++      /* Count the number of 4 bits values */+      Z = Bits[j];+      for (i = 0; i < 8; i++) {+         (ncount[Z & MASK4])++;+         Z >>= 4;+      }++      /* Count the number of runs and get the longest runs */+      Z = Bits[j];+      jBit = bitset_maskUL[31];++      while (jBit > 0) {+         if (Z & jBit) {          /* bit 1 */+            if (prevBit != 1) {+               if (len < 6)+                  (nrun0[len])++;+               else+                  (nrun0[6])++;+               if (len > longest0)+                  longest0 = len;+               len = 1;+            } else {+               len++;+            }+            prevBit = 1;++         } else {                 /* bit 0 */+            if (prevBit != 0) {+               if (len < 6)+                  (nrun1[len])++;+               else+                  (nrun1[6])++;+               if (len > longest1)+                  longest1 = len;+               len = 1;+            } else {+               len++;+            }+            prevBit = 0;+         }+         jBit >>= 1;+      }+   }++   strcpy (bbattery_TestNames[0], "Monobit");+   strcpy (bbattery_TestNames[1], "Poker");+   j = 1;+   strcpy (bbattery_TestNames[++j], "0 Runs, length 1: ");+   strcpy (bbattery_TestNames[++j], "0 Runs, length 2: ");+   strcpy (bbattery_TestNames[++j], "0 Runs, length 3: ");+   strcpy (bbattery_TestNames[++j], "0 Runs, length 4: ");+   strcpy (bbattery_TestNames[++j], "0 Runs, length 5: ");+   strcpy (bbattery_TestNames[++j], "0 Runs, length 6+: ");+   strcpy (bbattery_TestNames[++j], "1 Runs, length 1: ");+   strcpy (bbattery_TestNames[++j], "1 Runs, length 2: ");+   strcpy (bbattery_TestNames[++j], "1 Runs, length 3: ");+   strcpy (bbattery_TestNames[++j], "1 Runs, length 4: ");+   strcpy (bbattery_TestNames[++j], "1 Runs, length 5: ");+   strcpy (bbattery_TestNames[++j], "1 Runs, length 6+: ");++   strcpy (bbattery_TestNames[++j], "Longest run of 0: ");+   strcpy (bbattery_TestNames[++j], "Longest run of 1: ");++   WriteReportFIPS_140_2 (genName, fileFlag, nbit, longest0, longest1,+      nrun0, nrun1, ncount);+}+++/*-------------------------------------------------------------------------*/++void bbattery_FIPS_140_2 (unif01_Gen * gen)+{+   FIPS_140_2 (gen, NULL);+}+++/*-------------------------------------------------------------------------*/++void bbattery_FIPS_140_2File (char *filename)+{+   FIPS_140_2 (NULL, filename);+}+++/*=========================================================================*/
+ cbits/testu/src/bitset.c view
@@ -0,0 +1,222 @@+/*************************************************************************\+ *+ * Package:        MyLib+ * File:           bitset.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/+++#include "bitset.h"+#include "util.h"+#include <stdio.h>+#include <string.h>+#include <limits.h>+++unsigned long bitset_maskUL[] = {+   1,+   2,+   4,+   8,+   16,+   32,+   64,+   128,+   256,+   512,+   1024,+   2048,+   4096,+   8192,+   16384,+   32768,+   65536,+   131072,+   262144,+   524288,+   1048576,+   2097152,+   4194304,+   8388608,+   16777216,+   33554432,+   67108864,+   134217728,+   268435456,+   536870912,+   1073741824,+   2147483648UL+#if ULONG_MAX > 4294967295UL+   ,+   4294967296,+   8589934592,+   17179869184,+   34359738368,+   68719476736,+   137438953472,+   274877906944,+   549755813888,+   1099511627776,+   2199023255552,+   4398046511104,+   8796093022208,+   17592186044416,+   35184372088832,+   70368744177664,+   140737488355328,+   281474976710656,+   562949953421312,+   1125899906842624,+   2251799813685248,+   4503599627370496,+   9007199254740992,+   18014398509481984,+   36028797018963968,+   72057594037927936,+   144115188075855872,+   288230376151711744,+   576460752303423488,+   1152921504606846976,+   2305843009213693952,+   4611686018427387904,+   9223372036854775808UL+#endif+   };+++/*--------------------------------------------------------------------------*/++unsigned long bitset_MASK[] = {+   0,+   1,+   3,+   7,+   15,+   31,+   63,+   127,+   255,+   511,+   1023,+   2047,+   4095,+   8191,+   16383,+   32767,+   65535,+   131071,+   262143,+   524287,+   1048575,+   2097151,+   4194303,+   8388607,+   16777215,+   33554431,+   67108863,+   134217727,+   268435455,+   536870911,+   1073741823,+   2147483647,+   4294967295UL+#if ULONG_MAX > 4294967295UL+   ,+   8589934591,+   17179869183,+   34359738367,+   68719476735,+   137438953471,+   274877906943,+   549755813887,+   1099511627775,+   2199023255551,+   4398046511103,+   8796093022207,+   17592186044415,+   35184372088831,+   70368744177663,+   140737488355327,+   281474976710655,+   562949953421311,+   1125899906842623,+   2251799813685247,+   4503599627370495,+   9007199254740991,+   18014398509481983,+   36028797018963967,+   72057594037927935,+   144115188075855871,+   288230376151711743,+   576460752303423487,+   1152921504606846975,+   2305843009213693951,+   4611686018427387903,+   9223372036854775807,+   18446744073709551615UL+#endif+   };++/*--------------------------------------------------------------------------*/+++void bitset_WriteSet (char *desc, bitset_BitSet S, int n)+{+   int i;+   bitset_BitSet mask;+   +   util_Assert (n > 0, "bitset_WriteSet:   s <= 0");+   if ((unsigned) n > CHAR_BIT * sizeof (bitset_BitSet)) {+      n = CHAR_BIT * sizeof (bitset_BitSet);+      printf ("********** bitset_WriteSet:   only %d bits in a BitSet\n\n", n);+   }+   if (desc != NULL && strlen (desc) > 0)+      printf ("%s", desc);+   mask = (bitset_BitSet) 1 << (n - 1);+   for (i = 0; i < n; i++) {+      if (S & mask)+         printf ("1");+      else+         printf ("0");+      mask >>= 1;+   }+}+++/*--------------------------------------------------------------------------*/++bitset_BitSet bitset_Reverse (bitset_BitSet Z, int s)+{+   unsigned long res = 0;+   int i;++   for (i = 0; i < s; i++) {+      res = (res << 1) | (Z & 1);+      Z >>= 1;+   }+   return res;+}+
+ cbits/testu/src/chrono.c view
@@ -0,0 +1,226 @@+/*************************************************************************\+ *+ * Package:        MyLib+ * File:           chrono.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#ifdef HAVE_CONFIG_H+#include "config.h"+#endif++#include "chrono.h"+#include "gdef.h"+#include "util.h"+#include "num.h"++#include <time.h>+#include <stdio.h>+#include <stdlib.h>++#ifdef HAVE_WINDOWS_H++#include <windows.h>++static HANDLE currentProcess = NULL;++/*+ * A helper function for converting FILETIME to a LONGLONG [safe from memory+ * alignment point of view].+ */+static ULONGLONG+fileTimeToInt64 (const FILETIME * time)+{+    ULARGE_INTEGER _time;+    _time.LowPart = time->dwLowDateTime;+    _time.HighPart = time->dwHighDateTime;+    return _time.QuadPart;+}++static void Heure (unsigned long *tsec, unsigned long *tusec) {+   if (currentProcess == NULL)+      currentProcess = GetCurrentProcess();+   FILETIME creationTime, exitTime, kernelTime, userTime;+   /* Strongly inspired from+    * http://www.javaworld.com/javaworld/javaqa/2002-11/01-qa-1108-cpu.html */+   GetProcessTimes (currentProcess, &creationTime, &exitTime,+		   &kernelTime, &userTime);+   ULONGLONG rawTime = fileTimeToInt64 (&kernelTime) ++     fileTimeToInt64 (&userTime);+   /* We have to divide by 10000 to get milliseconds out of+    * the computed time */+   *tsec = (unsigned long)(rawTime / 10000000);+   *tusec = (unsigned long)((rawTime % 10000000) / 10);+}+++#elif defined(USE_ANSI_CLOCK)+/* ANSI C timer */++static void Heure (+   unsigned long *tsec,            /* Seconds */+   unsigned long *tmicrosec        /* Micro-seconds */+   )+/* + * Function returning the CPU time used by a program since it was+ * started. This function is ANSI C compliant.+ */+{+   clock_t t;+   double y;++   t = clock ();+   y = ((double) t) / CLOCKS_PER_SEC;+   *tsec = y;+   *tmicrosec = (y - *tsec) * 1000000;+}+++#else+/* POSIX timer */++#include <sys/times.h>+#include <unistd.h>++static void Heure (unsigned long *tsec, unsigned long *tusec)+/*+ * Function returning the CPU time used by a program since it was+ * started. This function is NOT ANSI C compliant.+ */+{+   struct tms us;+   long TICKS, z;++   TICKS = sysconf(_SC_CLK_TCK);+   if (TICKS == -1) {+     fprintf (stdout, "chrono.c:   'sysconf(_SC_CLK_TCK)' failed\n");+   }+   z = times (&us);+   if (z == -1) {+      fprintf (stdout, "chrono.c:   timer times failed\n");+   }++   /* CPU time = user time + system time */+   *tusec = us.tms_utime + us.tms_stime;++   *tsec = *tusec / TICKS;+   *tusec = (*tusec % TICKS) * 1000000 / TICKS;+}++#endif+++/*------------------------------------------------------------------------*/++void chrono_Init (chrono_Chrono *C)+{+   Heure (&C->second, &C->microsec);+}+++chrono_Chrono * chrono_Create (void)+{+   chrono_Chrono *C;+   C = (chrono_Chrono *) util_Malloc (sizeof (chrono_Chrono));+   Heure (&C->second, &C->microsec);+   return C;+}+++void chrono_Delete (chrono_Chrono *C)+{+   util_Free (C);+}+++double chrono_Val (chrono_Chrono *C, chrono_TimeFormat Unit)+{+   double temps;                     /* Time elapsed, in seconds */+   chrono_Chrono now;+   Heure (&now.second, &now.microsec);+   temps = (((double) now.microsec - (double) C->microsec) / 1.E+6 ++             (double) now.second) - (double) C->second;++   switch (Unit) {+   case chrono_sec:+      return temps;+   case chrono_min:+      return temps * 1.666666667E-2;+   case chrono_hours:+      return temps * 2.777777778E-4;+   case chrono_days:+      return temps * 1.157407407E-5;+   case chrono_hms:+      util_Error ("chrono_Val : hms is a wrong arg for chrono_TimeUnit");+   }+   return 0.0;+}++void chrono_Write (chrono_Chrono * C, chrono_TimeFormat Form)+{+   long centieme;+   long minute;+   long heure;+   long seconde;+   double temps;+   if (Form != chrono_hms)+      temps = chrono_Val (C, Form);+   else+      temps = 0.0;+   switch (Form) {+   case chrono_sec:+      num_WriteD (temps, 10, 2, 1);+      printf (" seconds");+      break;+   case chrono_min:+      num_WriteD (temps, 10, 2, 1);+      printf (" minutes");+      break;+   case chrono_hours:+      num_WriteD (temps, 10, 2, 1);+      printf (" hours");+      break;+   case chrono_days:+      num_WriteD (temps, 10, 2, 1);+      printf (" days");+      break;+   case chrono_hms:+      temps = chrono_Val (C, chrono_sec);+      heure = (long) (temps * 2.777777778E-4);+      if (heure > 0)+         temps -= (double) (heure) * 3600.0;+      minute = (long) (temps * 1.666666667E-2);+      if (minute > 0)+         temps -= (double) (minute) * 60.0;+      seconde = (long) (temps);+      centieme = (long) (100.0 * (temps - (double) (seconde)));+      printf ("%02ld:", heure);+      printf ("%02ld:", minute);+      printf ("%02ld.", seconde);+      printf ("%02ld", centieme);+      break;+   }+}
+ cbits/testu/src/fbar.c view
@@ -0,0 +1,1313 @@+/*************************************************************************\+ *+ * Package:        ProbDist+ * File:           fbar.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "fbar.h"+#include "fdist.h"++#include "num.h"+#include "num2.h"+#include "util.h"+#include "gdef.h"++#include <math.h>+#include <float.h>++double fdist_belog(double);+extern const double fdist_XINF;+extern const double fdist_XBIG;+extern const double fdist_XBIGM;++/* EpsArray[j]: Epsilon required for j decimal degits of precision */+static const double EpsArray[] = {+   0.5, 0.5E-1, 0.5E-2, 0.5E-3, 0.5E-4, 0.5E-5, 0.5E-6, 0.5E-7, 0.5E-8,+   0.5E-9, 0.5E-10, 0.5E-11, 0.5E-12, 0.5E-13, 0.5E-14, 0.5E-15, 0.5E-16,+   0.5E-17, 0.5E-18, 0.5E-19, 0.5E-20, 0.5E-21, 0.5E-22, 0.5E-23, 0.5E-24,+   0.5E-25, 0.5E-26, 0.5E-27, 0.5E-28, 0.5E-29, 0.5E-30, 0.5E-31, 0.5E-32,+   0.5E-33, 0.5E-34, 0.5E-35+};++/* Compute IMAX extra terms in the tails of discrete distributions */+static const long IMAX = 20;++++/*=========================================================================*/++double fbar_Unif (double x)+{+   if (x <= 0.0)+      return 1.0;+   if (x >= 1.0)+      return 0.0;+   return 1.0 - x;+}+++/*=========================================================================*/++double fbar_Expon (double x)+{+   if (x <= 0.0)+      return 1.0;+   if (x >= fdist_XBIGM)+      return 0.0;+   return exp (-x);+}+++/*=========================================================================*/++double fbar_Weibull (double c, double x)+{+   double temp;+   util_Assert (c > 0.0, "fbar_Weibull:   c <= 0");+   if (x <= 0.0)+      return 1.0;+   if (x >= DBL_MAX_EXP * FLT_RADIX && c >= 1.0)+      return 0.0;+   temp = c*log(x);+   if (temp >= DBL_MAX_EXP * num_Ln2)+      return 0.0;+   temp = exp(temp);+   return (exp (-temp));+}+++/*=========================================================================*/++double fbar_Logistic (double x)+{+   if (x <= -fdist_XBIG) {+      return 1.0;+   }+   if (x >= fdist_XBIG) {+      return exp (-x);+   }+   return 1.0 / (1.0 + exp (x));+}+++/*=========================================================================*/++double fbar_Pareto (double c, double x)+{++   util_Assert (c > 0.0, "fbar_Pareto:   c <= 0");+   if (x <= 1.0)+      return 1.0;+   return (pow (x, -c));+}++/**************************************************************************/++double fbar_Normal1 (double x)+/*+ * Returns P[X >= x] = 1 - F(x) where F is the normal distribution by+ * computing the complementary distribution directly; it is thus more+ * precise in the tail.+ */+{+   static const double A[25] = {+      6.10143081923200418E-1,+     -4.34841272712577472E-1,+      1.76351193643605501E-1,+     -6.07107956092494149E-2,+      1.77120689956941145E-2,+     -4.32111938556729382E-3,+      8.54216676887098679E-4,+     -1.27155090609162743E-4,+      1.12481672436711895E-5,+      3.13063885421820973E-7,+     -2.70988068537762022E-7,+      3.07376227014076884E-8,+      2.51562038481762294E-9,+     -1.02892992132031913E-9,+      2.99440521199499394E-11,+      2.60517896872669363E-11,+     -2.63483992417196939E-12,+     -6.43404509890636443E-13,+      1.12457401801663447E-13,+      1.7281533389986098E-14,+     -4.2641016949424E-15,+     -5.4537197788E-16,+      1.5869760776E-16,+      2.08998378E-17,+     -0.5900E-17+   };+   const double kk = 5.30330085889910643300;      /* 3.75 Sqrt(2) */+   double y, t;+   int Neg;++   if (x >= fdist_XBIG) {+      return 0.0;+   }+   if (x <= -fdist_XBIG) {+      return 1.0;+   }++   if (x >= 0.0)+      Neg = 0;+   else {+      Neg = 1;+      x = -x;+   }++   t = (x - kk) / (x + kk);+   y = num2_EvalCheby (A, 24, t);+   y = y * exp (-x * x / 2.0) / 2.0;++   if (Neg == 1)+      return (1.0 - y);+   else+      return (y);+}+++/*=========================================================================*/++double fbar_Normal2 (double x)+{+   static const double V[121] = {+        1.2533141373155,      1.137490921203605,      1.037824575853727,+      0.951527192071207,     0.8763644564536924,     0.8105337152790306,+     0.7525711790634081,     0.7012808218544303,     0.6556795424187987,+       0.61495459615093,     0.5784303460476312,     0.5455421356582171,+     0.5158156382179634,     0.4888504415275737,     0.4643069280394423,+     0.4418957328326002,     0.4213692292880546,     0.4025146181296722,+     0.3851482907984348,     0.3691112106902635,     0.3542651113297938,+     0.3404893532870847,     0.3276783146905521,       0.31573921586941,+     0.3045902987101033,     0.2941592970402893,      0.284382146748493,+     0.2752018941576065,     0.2665677689682238,     0.2584343943120386,+     0.2507611114439651,      0.243511400615456,     0.2366523829135607,+      0.230154390478801,     0.2239905946538289,     0.2181366833614714,+     0.2125705804420318,     0.2072722008565011,     0.2022232366330547,+     0.1974069692375194,     0.1928081047153158,     0.1884126285076003,+     0.1842076773079702,     0.1801814257143918,     0.1763229857571027,+     0.1726223176578506,     0.1690701504076941,     0.1656579109468773,+     0.1623776608968675,     0.1592220399363674,     0.1561842150339759,+      0.153257834853479,     0.1504369887362691,     0.1477161697413935,+      0.145090241289131,     0.1425544070104023,     0.1401041834530503,+     0.1377353753382303,     0.1354440530967635,     0.1332265324471292,+     0.1310793558044918,     0.1289992753343376,      0.126983237485437,+     0.1250283688553504,     0.1231319632579323,     0.1212914698765462,+      0.119504482399253,     0.1177687290432979,     0.1160820633859823,+     0.1144424559276431,      0.112847986320103,     0.1112968362007359,+     0.1097872825783083,     0.1083176917221132,     0.1068865135106745,+     0.1054922762005562,     0.1041335815795983,     0.1028091004723001,+     0.1015175685681028,     0.1002577825460485,    0.09902859647173194,+    0.09782891844465691,    0.09665770747608191,    0.09551397057921558,+    0.09439676005522439,    0.09330517095996169,    0.09223833873763035,+    0.09119543700877471,    0.09017567550106469,    0.08917829811230435,+    0.08820258109597616,    0.08724783136042988,    0.08631338487354936,+    0.08539860516539227,    0.08450288192189578,    0.08362562966329139,+    0.08276628650136918,    0.08192431297018954,    0.08109919092525536,+    0.08029042250654048,    0.07949752916111721,    0.07872005072144664,+    0.07795754453568722,    0.07720958464664668,    0.07647576101624852,+    0.07575567879261112,    0.07504895761704659,    0.07435523096847724,+    0.07367414554294564,    0.07300536066605566,    0.07234854773633338,+    0.07170338969763433,    0.07106958053885212,    0.07044682481930167,+    0.06983483721825942,    0.06923334210724434,    0.06864207314371742,+    0.06806077288496332,     0.0674891924209997,    0.06692709102543307,+    0.06637423582325017+};++   int j;+   lebool negatif;+   double t, u, z, h;+   double r, r1, r2, r3, r4, r5, r6, r7, r8;++   if (x >= fdist_XBIG) {+      return 0.0;+   }+   if (x <= -fdist_XBIG) {+      return 1.0;+   }+   if (x < 0.0) {+      negatif = TRUE;+      x = -x;+   } else {+      negatif = FALSE;+   }+   j = (int) (8.0 * x + 0.5);+   if (j > 120)+      j = 120;+   z = 0.125 * j;+   h = x - z;+   r = V[j];+   r1 = r * z - 1.0;+   r2 = 0.5 * (r + z * r1);+   r3 = (r1 + z * r2) / 3.0;+   r4 = 0.25 * (r2 + z * r3);+   r5 = 0.2 * (r3 + z * r4);+   r6 = (r4 + z * r5) / 6.0;+   r7 = (r5 + z * r6) / 7.0;+   r8 = 0.125 * (r6 + z * r7);+   t = r + h * (r1 + h * (r2 + h * (r3 + h * (r4 + h * (r5 + h * (r6 ++                h * (r7 + h * r8)))))));+   u = t * exp (-0.5 * x * x - 0.9189385332046727);+   if (negatif)+      return 1.0 - u;+   else+      return u;+}+++/*=========================================================================*/+#ifdef HAVE_ERF++double fbar_Normal3 (double x)+{+   return 0.5 * erfc (x * num_1Rac2);+}++#endif+/*=========================================================================*/++double fbar_BiNormal1 (double x, double y, double rho, int ndig)+{+   return fdist_BiNormal1(-x, -y, rho, ndig);+}+++/*=========================================================================*/++double fbar_BiNormal2 (double x, double y, double rho)+{+   return fdist_BiNormal2 (-x, -y, rho);+}+++/*=========================================================================*/++double fbar_LogNormal (double mu, double sigma, double x)+{+   util_Assert (sigma > 0.0, "fbar_LogNormal:  sigma  <= 0");+   if (x <= 0.0)+      return 1.0;+   return fbar_Normal1 ((log (x) - mu) / sigma);+}+++/*=========================================================================*/++double fbar_JohnsonSB (double alpha, double beta, double a, double b,+   double x)+{+   util_Assert (beta > 0.0, "fbar_JohnsonSB:  beta  <= 0");+   util_Assert (b > a, "fbar_JohnsonSB:  b  <= a");+   if (x <= a)+      return 1.0;+   if (x >= b)+      return 0.0;+   return fbar_Normal1 (alpha + beta * log ((x - a) / (b - x)));+}+++/*=========================================================================*/++double fbar_JohnsonSU (double alpha, double beta, double x)+{+   const double XLIM = 1.0e10;+   double r;+   lebool negative = FALSE;+   util_Assert (beta > 0.0, "fbar_JohnsonSU:  beta  <= 0");+   if (x < 0.0) {+      negative = TRUE;+      x = -x;+   }+   /* compute r = x + sqrt (x * x + 1) */+   if (x < XLIM)+      r = x + sqrt (x * x + 1.0);+   else+      r = 2.0 * x;+   if (negative)+      r = 1.0 / r;++   if (r > 0.0)+      return fbar_Normal1 (alpha + beta * log (r));+   else+      return 1.0;+}+++/*=========================================================================*/++static double F2AD[103];          /* Tables for the approximation of the */+static double CoAD[103];          /* Anderson-Darling distribution */++static void AndersonDarlingInit (void)+{+   F2AD[0] = 0.0;                F2AD[1] = 1.7315E-10;+   F2AD[2] = 2.80781E-5;         F2AD[3] = 1.40856E-3;+   F2AD[4] = 9.58772E-3;         F2AD[5] = 2.960552E-2;+   F2AD[6] = 6.185146E-2;        F2AD[7] = 1.0357152E-1;+   F2AD[8] = 1.5127241E-1;       F2AD[9] = 2.0190317E-1;+   F2AD[10] = 2.5318023E-1;      F2AD[11] = 3.0354278E-1;+   F2AD[12] = 3.5200015E-1;      F2AD[13] = 3.9797537E-1;+   F2AD[14] = 4.4117692E-1;      F2AD[15] = 4.8150305E-1;+   F2AD[16] = 5.1897375E-1;      F2AD[17] = 5.5368396E-1;+   F2AD[18] = 5.8577199E-1;      F2AD[19] = 6.1539864E-1;+   F2AD[20] = 6.4273362E-1;      F2AD[21] = 6.6794694E-1;+   F2AD[22] = 6.9120359E-1;      F2AD[23] = 7.126605E-1;+   F2AD[24] = 7.3246483E-1;      F2AD[25] = 7.507533E-1;+   F2AD[26] = 7.6765207E-1;      F2AD[27] = 7.8327703E-1;+   F2AD[28] = 7.9773426E-1;      F2AD[29] = 8.1112067E-1;+   F2AD[30] = 8.2352466E-1;      F2AD[31] = 8.3502676E-1;+   F2AD[32] = 8.4570037E-1;      F2AD[33] = 8.5561231E-1;+   F2AD[34] = 8.6482346E-1;      F2AD[35] = 8.7338931E-1;+   F2AD[36] = 8.8136046E-1;      F2AD[37] = 8.8878306E-1;+   F2AD[38] = 8.9569925E-1;      F2AD[39] = 9.0214757E-1;+   F2AD[40] = 9.081653E-1;       F2AD[41] = 9.1378043E-1;+   F2AD[42] = 9.1902284E-1;      F2AD[43] = 9.2392345E-1;+   F2AD[44] = 9.2850516E-1;      F2AD[45] = 9.3279084E-1;+   F2AD[46] = 9.3680149E-1;      F2AD[47] = 9.4055647E-1;+   F2AD[48] = 9.440736E-1;       F2AD[49] = 9.4736933E-1;+   F2AD[50] = 9.5045883E-1;      F2AD[51] = 9.5335611E-1;+   F2AD[52] = 9.5607414E-1;      F2AD[53] = 9.586249E-1;+   F2AD[54] = 9.6101951E-1;      F2AD[55] = 9.6326825E-1;+   F2AD[56] = 9.6538067E-1;      F2AD[57] = 9.6736563E-1;+   F2AD[58] = 9.6923135E-1;      F2AD[59] = 9.7098548E-1;+   F2AD[60] = 9.7263514E-1;      F2AD[61] = 9.7418694E-1;+   F2AD[62] = 9.7564704E-1;      F2AD[63] = 9.7702119E-1;+   F2AD[64] = 9.7831473E-1;      F2AD[65] = 9.7953267E-1;+   F2AD[66] = 9.8067966E-1;      F2AD[67] = 9.8176005E-1;+   F2AD[68] = 9.827779E-1;       F2AD[69] = 9.8373702E-1;+   F2AD[70] = 9.8464096E-1;      F2AD[71] = 9.8549304E-1;+   F2AD[72] = 9.8629637E-1;      F2AD[73] = 9.8705386E-1;+   F2AD[74] = 9.8776824E-1;      F2AD[75] = 9.8844206E-1;+   F2AD[76] = 9.8907773E-1;      F2AD[77] = 9.8967747E-1;+   F2AD[78] = 9.9024341E-1;      F2AD[79] = 9.9077752E-1;+   F2AD[80] = 9.9128164E-1;      F2AD[81] = 9.9175753E-1;+   F2AD[82] = 9.9220682E-1;      F2AD[83] = 9.9263105E-1;+   F2AD[84] = 9.9303165E-1;      F2AD[85] = 9.9340998E-1;+   F2AD[86] = 9.9376733E-1;      F2AD[87] = 9.9410488E-1;+   F2AD[88] = 9.9442377E-1;      F2AD[89] = 9.9472506E-1;+   F2AD[90] = 9.9500974E-1;      F2AD[91] = 9.9527876E-1;+   F2AD[92] = 9.95533E-1;        F2AD[93] = 9.9577329E-1;+   F2AD[94] = 9.9600042E-1;      F2AD[95] = 9.9621513E-1;+   F2AD[96] = 9.964181E-1;       F2AD[97] = 0.99661;+   F2AD[98] = 9.9679145E-1;      F2AD[99] = 9.9696303E-1;+   F2AD[100] = 9.9712528E-1;     F2AD[101] = 9.9727872E-1;+   F2AD[102] = 9.9742384E-1;++   CoAD[0] = 0.0;+   CoAD[1] = 0.0;                 CoAD[2] = 0.0;            +   CoAD[3] = 0.0;                 CoAD[4] = 0.0;            +   CoAD[5] = -1.87E-3;            CoAD[6] = 0.00898;        +   CoAD[7] = 0.0209;              CoAD[8] = 0.03087;        +   CoAD[9] = 0.0377;              CoAD[10] = 0.0414;        +   CoAD[11] = 0.04386;            CoAD[12] = 0.043;         +   CoAD[13] = 0.0419;             CoAD[14] = 0.0403;        +   CoAD[15] = 0.038;              CoAD[16] = 3.54804E-2;    +   CoAD[17] = 0.032;              CoAD[18] = 0.0293;        +   CoAD[19] = 2.61949E-2;         CoAD[20] = 0.0228;        +   CoAD[21] = 0.0192;             CoAD[22] = 1.59865E-2;    +   CoAD[23] = 0.0129;             CoAD[24] = 0.0107;        +   CoAD[25] = 8.2464E-3;          CoAD[26] = 0.00611;       +   CoAD[27] = 0.00363;            CoAD[28] = 1.32272E-3;    +   CoAD[29] = -5.87E-4;           CoAD[30] = -2.75E-3;      +   CoAD[31] = -3.95248E-3;        CoAD[32] = -5.34E-3;      +   CoAD[33] = -6.892E-3;          CoAD[34] = -8.10208E-3;   +   CoAD[35] = -8.93E-3;           CoAD[36] = -9.552E-3;     +   CoAD[37] = -1.04605E-2;        CoAD[38] = -0.0112;       +   CoAD[39] = -1.175E-2;          CoAD[40] = -1.20216E-2;   +   CoAD[41] = -0.0124;            CoAD[42] = -1.253E-2;     +   CoAD[43] = -1.27076E-2;        CoAD[44] = -0.0129;       +   CoAD[45] = -1.267E-2;          CoAD[46] = -1.22015E-2;   +   CoAD[47] = -0.0122;            CoAD[48] = -1.186E-2;     +   CoAD[49] = -1.17218E-2;        CoAD[50] = -0.0114;       +   CoAD[51] = -1.113E-2;          CoAD[52] = -1.08459E-2;   +   CoAD[53] = -0.0104;            CoAD[54] = -9.93E-3;      +   CoAD[55] = -9.5252E-3;         CoAD[56] = -9.24E-3;      +   CoAD[57] = -9.16E-3;           CoAD[58] = -8.8004E-3;    +   CoAD[59] = -8.63E-3;           CoAD[60] = -8.336E-3;     +   CoAD[61] = -8.10512E-3;        CoAD[62] = -7.94E-3;      +   CoAD[63] = -7.71E-3;           CoAD[64] = -7.55064E-3;   +   CoAD[65] = -7.25E-3;           CoAD[66] = -7.11E-3;      +   CoAD[67] = -6.834E-3;          CoAD[68] = -0.0065;       +   CoAD[69] = -6.28E-3;           CoAD[70] = -6.11008E-3;   +   CoAD[71] = -5.86E-3;           CoAD[72] = -5.673E-3;     +   CoAD[73] = -5.35008E-3;        CoAD[74] = -5.11E-3;      +   CoAD[75] = -4.786E-3;          CoAD[76] = -4.59144E-3;   +   CoAD[77] = -4.38E-3;           CoAD[78] = -4.15E-3;      +   CoAD[79] = -4.07696E-3;        CoAD[80] = -3.93E-3;      +   CoAD[81] = -3.83E-3;           CoAD[82] = -3.74656E-3;   +   CoAD[83] = -3.49E-3;           CoAD[84] = -3.33E-3;      +   CoAD[85] = -3.20064E-3;        CoAD[86] = -3.09E-3;      +   CoAD[87] = -2.93E-3;           CoAD[88] = -2.78136E-3;   +   CoAD[89] = -2.72E-3;           CoAD[90] = -2.66E-3;      +   CoAD[91] = -2.56208E-3;        CoAD[92] = -2.43E-3;      +   CoAD[93] = -2.28E-3;           CoAD[94] = -2.13536E-3;   +   CoAD[95] = -2.083E-3;          CoAD[96] = -1.94E-3;      +   CoAD[97] = -1.82E-3;           CoAD[98] = -1.77E-3;      +   CoAD[99] = -1.72E-3;           CoAD[100] = -1.71104E-3;  +   CoAD[101] = -1.741E-3;         CoAD[102] = -0.0016;++}++double fbar_AndersonDarling (long N, double X)+{+   /* This function is not very precise for x < 0.05 */+   const double h = 0.05;         /* the step of the interpolation table */+   static int ADFlag = 0;+   double q;+   double Res, Cor;+   int i;++   if (N == 1) {+      if (X <= 0.38629436111989)+         return 1.0;+      if (X >= fdist_XBIGM)+         return 0.0;+      if (X < 6.0) {+         q = 1.0 - 4.0 * exp(-X - 1.0);+         return 1.0 - sqrt (q);+      } else {+         q = 4.0 * exp(-X - 1.0);+         return 0.5*q*(1.0 + 0.25*q*(1.0 + 0.5*q*(1.0 + 0.125*q*(5.0 + 3.5*q))));+      }+   }++   if (N <= 0) {+      util_Warning (1, "fbar_AndersonDarling:   N < 1");+      return -1.0;+   }++   if (X > 10.0)+      /* Sinclair-Spurr upper tail approximation (3.5) */+      return 1.732 * exp(-X) / sqrt(num_Pi * X);++   if (X > 5.0) {+      /* asymptotic X:  our empirical fit */+      Res = exp (-0.56 - 1.06 * X);+      q = exp (-1.03 - 1.06 * X);         /* Empirical correction in 1/N */+      return Res + q / N;+   }++   if (X <= 0.2)+      return 1.0 - fdist_AndersonDarling (N, X);++   if (ADFlag == 0) {+      AndersonDarlingInit ();+      ADFlag = 1;+   }++   i = 1 + (int) (X / h);+   q = X / h - i;++   /* Newton backwards quadratic interpolation */+   Res = (F2AD[i - 2] - 2.0 * F2AD[i - 1] + F2AD[i]) * q * (q + 1.0) / 2.0+      + (F2AD[i] - F2AD[i - 1]) * q + F2AD[i];++   /* Empirical correction in 1/N */+   Cor = (CoAD[i] * (q + 1.0) - CoAD[i - 1] * q) / N;++   Res = 1.0 - Res - Cor;+   if (Res >= 1.0)+      return 1.0;+   if (Res <= 0.0)+      return 0.0;+   return Res;+}+++/*=========================================================================*/++double fbar_ChiSquare1 (long N, double x)+/*+ * Returns an approximation of the complementary Chi square cdf (N degrees+ * of freedom). Similar to p:116 of W.J.Kennedy Jr and J.E.Gentle.+ * Statistical computing, Dekker, New York, 1980. More precise in the+ * tail than simply returning  1 - fdist_ChiSquare.+ */+{+   const double XBIG_CHI = 2000.0;+   const double tiers = 0.33333333333333333;+   const double pt2 = 0.22222222222222222;+   const double moinshuit = -8.3;+   const double gam = 0.8862269254527579825931;+   double H, E, DemiX, Terme, Sommation, Y;+   long i;++   util_Assert (N > 0, "Calling fbar_ChiSquare1 with N < 1");+   if (x <= 0.0)+      return 1.0;+   if (N >= 150) {+      if (x >= N * fdist_XBIG)+         return 0.0;+   } else {+      if (x >= XBIG_CHI)+         return 0.0;+   }++   if (N > 1000) {+      if (x < 2.0)+         return 1.0;+      x = (pow ((x / N), tiers) - (1.0 - pt2 / N)) / sqrt (pt2 / N);+      if (x > 35.0)+         return 0.0;+      if (x <= moinshuit)+         return 1.0;+      return fbar_Normal1 (x);+   }++   DemiX = x / 2.0;++   if (!(N & 1)) {             /* even N */+      Terme = exp (-DemiX);+      Sommation = Terme;+      for (i = 1; i < N / 2; i++) {+	 Terme = Terme * DemiX / i;+	 Sommation += Terme;+      }+      Y = Sommation;++   } else {+      H = 2.0 * fbar_Normal1 (sqrt (x));+      if (N == 1)+	 return H;++      E = exp (-DemiX);+      Terme = sqrt (DemiX) * E / gam;+      for (i = 3; i < N; i += 2) {+	 H += Terme;+	 Terme = Terme * DemiX * 2.0 / i;+      }+      Y = H + Terme;+   }++   if (Y > 1.0)+      return 1.0;+   else +      return Y;+}+++/*=========================================================================*/++double fbar_ChiSquare2 (long n, int d, double x)+{+   util_Assert (n > 0, "fbar_ChiSquare2:   n <= 0");+   if (x <= 0.0)+      return 1.0;+   return fbar_Gamma (n / 2.0, d, x / 2.0);+}+++/*=========================================================================*/++double fbar_Gamma (double alpha, int d, double x)+{+   const double aLIM = 1.0E5;+   const double RENORM = 1.0E100;+   const double EPS = EpsArray[d];+   double V[6];+   double v, res, A, B, R, term, dif;+   int i;++   util_Assert (alpha > 0.0, "fbar_Gamma:   a <= 0");+   util_Assert (d > 0, "fbar_Gamma:   d <= 0");+   util_Assert (d < 16, "fbar_Gamma:   d > 15");+   if (x <= 0.0)+      return 1.0;+   if (1.0 == alpha)+      return fbar_Expon (x);++   if (alpha >= 70.0) {+      if (x >= alpha * fdist_XBIG)+         return 0.0;+   } else {+      if (x >= fdist_XBIGM)+         return 0.0;+   }++   if (alpha >= aLIM) {+      double d2 = x + 1.0/3.0 - alpha - 0.02/alpha;+      double S = alpha - 1.0/2.0;+      double z = d2 * sqrt((1 + fdist_belog(S/x))/x);+      return fbar_Normal1 (z);+   }++   if (x <= 1.0 || x < alpha)+      return 1.0 - fdist_Gamma (alpha, d, x);++   v = exp (alpha * log (x) - x - num2_LnGamma (alpha));++   A = 1.0 - alpha;+   B = A + x + 1.0;+   term = 0.0;+   V[0] = 1.0;+   V[1] = x;+   V[2] = x + 1.0;+   V[3] = x * B;+   res = V[2] / V[3];++   do {+      A += 1.0;+      B += 2.0;+      term += 1.0;+      V[4] = B * V[2] - A * term * V[0];+      V[5] = B * V[3] - A * term * V[1];+      if (V[5] != 0.0) {+         R = V[4] / V[5];+         dif = fabs (res - R);+         if (dif <= EPS * R)+            return (v * res);+         res = R;+      }+      for (i = 0; i < 4; i++)+         V[i] = V[i + 2];+      if (fabs (V[4]) >= RENORM) {+         for (i = 0; i < 4; i++)+            V[i] /= RENORM;+      }+   } while (1);++   /* to eliminate a warning from the compiler; never reached */+   return 0.0;+}+++/*=========================================================================*/++static double KSPlusbarAsymp (long n, double x)+{+   /* Compute the probability of the KSPlus distribution using +      an asymptotic formula */+   double t = (6.0*n*x + 1);+   double z = t*t/(18.0*n);+   double v = 1.0 - (2.0*z*z - 4.0*z - 1.0)/(18.0*n);+   if (v <= 0.0)+      return 0.0;+   v = v*exp(-z);+   if (v >= 1.0)+      return 1.0;+   return v;+}+++/*-------------------------------------------------------------------------*/++static double KSPlusbarUpper (long n, double x)+{+   /* Compute the probability of the KSPlus distribution in the upper+      tail using Smirnov's stable formula */+   const double EPSILON = 1.0E-10;+   double q;+   double Sum = 0.0;+   double term;+   double t;+   double LogCom;+   double LOGJMAX;+   int j;+   int jmax = (int)(n - n*x);++   /* We must avoid log(0) for j = jmax and q ~ 1.0 */+   if ((1.0 - x - (double)jmax / n) <= 0.0)+      jmax--;++   j = jmax/2;+   LogCom = num2_LnFactorial((int)n) - num2_LnFactorial(j) -+            num2_LnFactorial((int)(n-j));+   LOGJMAX = LogCom;++   while (j > 0) {+      q = (double)j / n + x;+      term = LogCom + (j - 1)*log (q) + (n - j)*num2_log1p (-q);+      t = exp (term);+      Sum += t;+      LogCom += log ((double)j / (n - j + 1));+      if (t <= Sum*EPSILON)+         break;+      j--;+   }++   j = jmax/2;+   LogCom = LOGJMAX + log ((double)(n - j)/(j + 1));+   j++;++   while (j <= jmax) {+      q = (double)j / n + x;+      term = LogCom + (j - 1)*log(q) + (n - j)*num2_log1p(-q);+      t = exp (term);+      Sum += t;+      LogCom += log ((double)(n - j)/(j + 1));+      if (t <= Sum*EPSILON)+         break;+      j++;+   }++   Sum *= x;+   /* add the term j = 0 */+   Sum += exp (n*num2_log1p (-x));+   return Sum;+}+++/*=========================================================================*/++double fbar_KSPlus (long N, double x)+{+   const double NxParam = 6.5;    /* frontier: alternating series */+   const long NParam = 4000;      /* frontier: non-alternating series */+   const long NAsymp = 200000;    /* frontier: asymptotic */++   util_Assert (N > 0, "Calling fbar_KSPlus with N < 1");+   if (x <= 0.0)+      return 1.0;+   if ((x >= 1.0) || (N*x*x >= 370.0))+      return 0.0;+   if (N == 1)+      return 1.0 - x;++   if (N * x <= NxParam)+      return 1.0 - fdist_KSPlus (N, x);++   if (N >= NAsymp)+      return KSPlusbarAsymp (N, x);++   if ((N <= NParam) || (N*x*x > 1.0))+      return KSPlusbarUpper(N, x);++/*   return (1.0 - 2.0*x/3.0)*exp(-2.0*N*x*x);  */+   return KSPlusbarAsymp (N, x);+}+++/*=========================================================================*/++static double KSSpecial (long n, double x)+{+#define NLIM 20++   if ((n * x * x >= 370.0) || (x >= 1.0))+      return 0.0;+   if (x <= 0.5 / n)+      return 1.0;+   if (n == 1)+      return 2.0 - 2.0 * x;++   if (x <= 1.0 / n) {+      double w;+      double t = 2.0 * x - 1.0 / n;+      if (n <= NLIM) {+         w = num2_Factorial ((int) n);+         return 1.0 - w * pow (t, (double) n);+      }+      w = num2_LnFactorial ((int) n) + n * log (t);+      return 1.0 - exp (w);+   }++   if (x >= 1.0 - 1.0 / n) {+      return 2.0 * pow (1.0 - x, (double) n);+   }+   return -1.0;+}++#undef NLIM+/*-------------------------------------------------------------------------*/++double fbar_KS1 (long n, double x)+{+   double v = KSSpecial(n, x);+   if (v >= 0.0)+      return v;++   if (n <= 400) {+      if (n*x*x < 4.0)+         return 1.0 - fdist_KS1(n, x);+      else +         return 2.0 * KSPlusbarUpper(n, x);+   }++   if (n*x*x >= 2.2) {+      if (n <= 200000)+         return 2.0 * KSPlusbarUpper(n, x);+      return 2.0*KSPlusbarAsymp (n, x);+   }+ +   return 1.0 - fdist_KS1(n, x);+}+++/*=========================================================================*/++double fbar_CramerMises (long N, double x)+{+   return 1.0 - fdist_CramerMises (N, x);+}+++double fbar_WatsonG (long N, double x)+{+   return 1.0 - fdist_WatsonG (N, x);+}+++/*=========================================================================*/++double fbar_WatsonU (long N, double x)+{+/*+ * Only the asymptotic form has been implemented. In the trivial case+ * N = 1, we simply return 0.5+ */+   const double xSepare = 0.15;+   if (x <= 0.0)+      return 1.0;+   if (x >= fdist_XBIG)+      return 0.0;++   if (N == 1)                    /* N = 1, degenerate case */+      return 0.5;++   if (x > xSepare) {+      /* this series converges rapidly for x > 0.15 */+      const int JMAX = 10;+      int j;+      double signe;+      double v;+      double terme;+      double somme;+      v = exp (-(x * 2.0 * num_Pi * num_Pi));+      signe = 1.0;+      somme = 0.0;+      j = 1;+      do {+         terme = pow (v, (double) j * j);+         somme += signe * terme;+         signe = -signe;+         ++j;+      } while (!(terme < DBL_EPSILON || j > JMAX));+      util_Warning (j > JMAX, "fbar_WatsonU:  sum1 has not converged");+      v = 2.0 * somme;+      if (v <= 0.0)+         return 0.0;+      return v;+   }++   return 1.0 - fdist_WatsonU (N, x);+}+++/*=========================================================================*/+++++/******************************\+ *+ *  DISCRETE DISTRIBUTIONS+ *+\******************************/+++/*=========================================================================*/++static const double epsilonScan = 1.0E-7;++static double ScanGlaz (long N, double d, long m)+{+   long j, jmoy;+   double temp;+   double jr, jm1r, Nr = N;+   int signe;+   double q = 1.0 - d;+   double Q4, Q3, Q2, Q1;+   double Bin, BinMoy;++   jmoy = (long) ((N + 1) * d);    /* max term of the Binomial */+   if (jmoy < m - 1)+      jmoy = m - 1;++   /*---------------------------------------------------------*/+   /* Compute Q1: formula (2.5) in Glaz (1989)                */+   /* Compute Q2: formula (A.6) in Berman and Eagleson (1985) */+   /* Compute Q3, Q4 : Theorem (3.2) in Glaz (1989)           */+   /*---------------------------------------------------------*/++   /* compute the probability of term j = jmoy */+   Q1 = 0.0;+   for (j = 1; j <= jmoy; j++) {+      jr = j;+      Q1 += log (Nr - jr + 1.0) - log (jr);+   }+   Q1 += jmoy * log (d) + (Nr - jmoy) * log (q);+   BinMoy = exp (Q1);+   Q1 = BinMoy;+   jm1r = jmoy - m + 1;+   if ((jmoy - m + 1) & 1)+      signe = -1;+   else+      signe = 1;+   Q2 = signe * BinMoy;+   Q3 = signe * BinMoy * (2.0 - jm1r * jm1r + jm1r);+   Q4 = signe * BinMoy * (jm1r + 1.0) * (jm1r + 2.0) * (6.0 + jm1r * jm1r -+      5.0 * jm1r);++   /* compute the probability of terms j > jmoy */+   if ((jmoy - m + 1) & 1)+      signe = -1;+   else+      signe = 1;++   jm1r = jmoy - m + 1;+   Bin = BinMoy;+   for (j = jmoy + 1; j <= N; j++) {+      jr = j;+      jm1r += 1.0;+      signe = -signe;+      Bin = (Bin * (Nr - jr + 1.0) * d) / (jr * q);+      if (Bin < epsilonScan)+         break;+      Q1 += Bin;+      Q2 += signe * Bin;+      Q3 += signe * Bin * (2.0 - jm1r * jm1r + jm1r);+      Q4 += signe * Bin * (jm1r + 1.0) * (jm1r + 2.0) * (6.0 + jm1r * jm1r -+         5.0 * jm1r);+   }++   Q1 = 1.0 - Q1;+   Q3 /= 2.0;+   Q4 /= 12.0;+   if (m == 3) {+      /* Problem with this formula; I do not get the same results as Glaz */+      Q4 = ((Nr * (Nr - 1.0) * d * d * pow (q, Nr - 2.0)) / 8.0+         + Nr * d * 2.0 * pow (1.0 - 2.0 * d, Nr - 1.0))+         - 4.0 * pow (1.0 - 2.0 * d, Nr);+      if (d < 1.0 / 3.0) {+         Q4 += Nr * d * 2.0 * pow (1.0 - 3.0 * d, Nr - 1.0)+               + 4.0 * pow (1.0 - 3.0 * d, Nr);+      }+   }+   /* compute probability: Glaz, equations (3.2) and (3.3) */+   Q3 = Q1 - Q2 - Q3;+   Q4 = Q3 - Q4;+   /* when the approximation is bad, avoid overflow */+   temp = log (Q3) + (Nr - m - 2.0) * log (Q4 / Q3);+   if (temp >= 0.0)+      return 0.0;+   if (temp < (-30.0))+      return 1.0;+   Q4 = exp (temp);+   return 1.0 - Q4;+}++/*----------------------------------------------------------------------*/++static double ScanWNeff (long N, double d, long m)+{+   double q = 1.0 - d;+   double temp;+   double Bin;+   double Sum;+   long j;++   /*--------------------------------------*/+   /* Anderson-Titterington: equation (4)  */+   /*--------------------------------------*/++   /* compute the probability of term j = m */+   Sum = 0.0;+   for (j = 1; j <= m; j++) {+      Sum += log ((double) (N - j + 1)) - log ((double) j);+   }+   Sum += m * log (d) + (N - m) * log (q);+   Bin = exp (Sum);+   temp = (m / d - N - 1.0) * Bin;+   Sum = Bin;++   /* compute the probability of terms j > m */+   for (j = m + 1; j <= N; j++) {+      Bin *= (N - j + 1) * d / (j * q);+      if (Bin < epsilonScan)+         break;+      Sum += Bin;+   }+   Sum = 2.0 * Sum + temp;+   return Sum;+}++/*----------------------------------------------------------------------*/++static double ScanAsympt (long N, double d, long m)+{+   double Kappa;+   double temp;+   double Theta;+   double Sum;++   /*--------------------------------------------------------------*/+   /* Anderson-Titterington: asymptotic formula after equation (4) */+   /*--------------------------------------------------------------*/++   Theta = sqrt (d / (1.0 - d));+   temp = sqrt ((double) N);+   Kappa = m / (d * temp) - temp;+   temp = Theta * Kappa;+   temp = temp * temp / 2.0;+   Sum = 2.0 * fbar_Normal1 (Theta * Kappa) ++      (Kappa * Theta * exp (-temp)) / (d * sqrt (2.0 * num_Pi));+   return Sum;+}++/*----------------------------------------------------------------------*/++double fbar_Scan (long N, double d, long m)+{+   double mu;+   double prob;++   util_Assert (N >= 2, "Calling fbar_Scan with N < 2");+   util_Assert (d > 0.0 && d < 1.0,+      "Calling fbar_Scan with d outside (0,1)");+   if (m > N)+      return 0.0;+   if (m <= 1)+      return 1.0;+   if (m <= 2) {+      if ((N - 1) * d >= 1.0)+         return 1.0;+      return (1.0 - pow (1.0 - (N - 1) * d, (double) N));+   }+   if (d >= 0.5 && m <= (N + 1) / 2.0)+      return 1.0;+   if (d > 0.5)+      return (-1.0);              /* Error */+   /* util_Assert (d <= 0.5, "Calling fbar_Scan with d > 1/2"); */++   mu = N * d;                    /* mean of a binomial */+   if (m <= mu + d)+      return 1.0;+   if (mu <= 10.0)+      return ScanGlaz (N, d, m);+   prob = ScanAsympt (N, d, m);+   if ((d >= 0.3 && N >= 50.0) || (N * d * d >= 250.0 && d < 0.3)) {+      if (prob <= 0.4)+         return prob;+   }+   prob = ScanWNeff (N, d, m);+   if (prob <= 0.4)+      return prob;+   prob = ScanGlaz (N, d, m);+   if (prob > 0.4 && prob <= 1.0)+      return prob;+   return 1.0;+}+++/*=========================================================================*/++double fbar_Geometric (double p, long n)+{+   util_Assert (p >= 0.0 && p <= 1.0, "fbar_Geometric:   p not in [0, 1]");+   if (n <= 0)+      return 1.0;+   if (p >= 1.0)                  /* In fact, p == 1 */+      return 0.0;+   if (p <= 0.0)                  /* In fact, p == 0 */+      return 1.0;++   return pow (1.0 - p, (double) n);+}+++/*=========================================================================*/++double fbar_Poisson1 (double lam, long s)+{+   const double lamlim = 150.0;+   long i;+   double term, sum;++   util_Assert (lam >= 0.0, "fbar_Poisson1:   lambda < 0");+   if (s <= 0)+      return 1.0;++   /* If lam > lamlim, we use the Chi2 distribution according to the exact+      relation, with 2s + 2 degrees of freedom++      fdist_Poisson (lam, s) = 1 - fdist_ChiSquare (2s + 2, 2*lam)++      which also equals   1 - fdist_Gamma (s + 1, lam) */+   if (lam > lamlim)+      return fdist_Gamma ((double) s, 15, lam);++   if (s <= lam)+      return 1.0 - fdist_Poisson1 (lam, s - 1);++   /* Sum at least IMAX prob. terms from i = s to i = oo */+   sum = term = fmass_PoissonTerm1 (lam, s);+   i = s + 1;+   while (term > fmass_Epsilon || i <= s + IMAX) {+      term *= lam / i;+      sum += term;+      i++;+   }+   return sum;+}+++/*=========================================================================*/++double fbar_Poisson2 (fmass_INFO W, long s)+/*+ * fbar_Poisson (lam, s) = 1 - fdist_Poisson (lam, s - 1)+ */+{+   double lam;++   util_Assert (W != NULL, "fbar_Poisson2:   fmass_INFO is NULL pointer");+   lam = W->paramR[0];++   if (s <= 0)+      return 1.0;++   /* For large lam,  we use the Chi2 distribution according to the exact+      relation, with 2s + 2 degrees of freedom++      fdist_Poisson (lam, s) = 1 - fdist_ChiSquare (2s + 2, 2*lam)+      fdist_Poisson (lam, s) = 1 - fdist_Gamma (s + 1, lam)+    */++   if (W->cdf == NULL)+      return fdist_Gamma ((double) s, 15, lam);++   if (s > W->smax)+      return fbar_Poisson1 (lam, s);++   if (s < W->smin)+      return 1.0;++   if (s > W->smed)+      /* We keep the complementary distribution in the upper part of cdf */+      return W->cdf[s - W->smin];+   else+      return 1.0 - W->cdf[s - 1 - W->smin];+}+++/*=========================================================================*/++double fbar_Binomial2 (fmass_INFO W, long s)+{+   double p;+   long n;++   util_Assert (W != NULL, "fbar_Binomial2:   fmass_INFO is NULL pointer");+   n = W->paramI[0];+   p = W->paramR[0];+   util_Assert (p >= 0.0 && p <= 1.0, "fbar_Binomial2:   p not in [0, 1]");++   if (0 == n)+      return 1.0;+   if (s < 1)+      return 1.0;+   if (s > n)+      return 0.0;+   if (p == 0.0)+      return 0.0;+   if (p == 1.0)+      return 1.0;++   if (W->cdf != NULL) {+      if (s >= W->smax) {+         /* Add IMAX dominant terms to get a few decimals in the tail */+         const double q = 1.0 - p;+         double z, sum, term;+         long i;+         sum = term = fmass_BinomialTerm3 (n, p, s);+         if (fabs (q) > 0.0) {+            z = p / q;+         } else {+            z = 0.0;+            util_Warning (1, "fbar_Binomial2:   p / q = infinite");+         }+         i = s;+         while (i < n && i < s + IMAX) {+            term = term * z * (n - i) / (i + 1);+            sum += term;+            i++;+         }+         return sum;+         /* return fdist_Beta (s, n - s + 1, 10, p); */+      }++      if (s <= W->smin)+         return 1.0;++      if (s > W->smed)+         /* We keep the complementary distribution in the upper part of cdf */+         return W->cdf[s - W->smin];+      else+         return 1.0 - W->cdf[s - 1 - W->smin];++   } else {+      return 1.0 - fdist_Binomial1 (n, p, s - 1);+   }+}+++/*=========================================================================*/++double fbar_NegaBin2 (fmass_INFO W, long s)+{+   double p;+   long n;++   util_Assert (W != NULL, "fbar_NegaBin2:   fmass_INFO is NULL pointer");+   n = W->paramI[0];+   p = W->paramR[0];+   util_Assert (p >= 0.0 && p <= 1.0, "fbar_NegaBin2:   p not in [0, 1]");++   if (s < 1)+      return 1.0;+   if (p >= 1.0)                  /* In fact, p == 1 */+      return 0.0;+   if (p <= 0.0)                  /* In fact, p == 0 */+      return 1.0;++   if (W->cdf == NULL)+      return fdist_Binomial1 (s - 1 + n, p, n - 1);++   if (s >= W->smax)+      return fdist_Binomial1 (s - 1 + n, p, n - 1);+   if (s <= W->smin)+      return 1.0;+   if (s > W->smed)+      /* We keep the complementary distribution in the upper part of cdf */+      return W->cdf[s - W->smin];+   else+      return 1.0 - W->cdf[s - 1 - W->smin];++}+++/*=========================================================================*/
+ cbits/testu/src/fcho.c view
@@ -0,0 +1,262 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           fcho.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "fcho.h"+#include "ftab.h"+#include "swrite.h"++#include <stdio.h>+#include <string.h>+#include <math.h>++++#define EPS2 1.0E-10+#define LEN 7+++++typedef struct {+   double a;+   double b;+   double c;+   fcho_FuncType F;+   char *name;+} Sample_Param;++++int fcho_Resolution = 30;+++/*-------------------------------- Functions ------------------------------*/++++double fcho_Linear (double x)+{+   return x;+}+++/*=========================================================================*/++double fcho_LinearInv (double x)+{+   return 1.0/x;+}+++/*=========================================================================*/++double fcho_2Pow (double x)+{+   return pow (2.0, x);+}+++/*=========================================================================*/++static void WriteSample (void *vpar, long junk, long j)+{+   Sample_Param *param = vpar;+   const double a = param->a;+   const double b = param->b;+   const double c = param->c;++   printf ("Choose  ");+   if (ftab_Style == ftab_Latex)+      printf ("$");+   if (param->name)+      printf ("%s", param->name);++   if (param->F == fcho_2Pow)+      printf (" = 2^{ ");+   else if (param->F == fcho_Linear)+      printf (" = ");+   else+      printf (" = F(");++   if (a > EPS2)+      printf ("%4.2f*i ", a);++   if (fabs (b*j) > EPS2) {+      if (b*j > EPS2)+         printf ("+ ");+      else+         printf ("- ");+      if (fabs (b - 1.0) > EPS2) +         printf ("%4.2f*%1ld ", fabs (b), labs (j));+      else+         printf ("%1ld ", labs (j));+   }++   if (c > EPS2)+      printf ("+ %4.2f", fabs (c));+   else if (c < -EPS2)+      printf ("- %4.2f", fabs (c));++   if (param->F == fcho_2Pow)+      printf ("}");+   else if (param->F == fcho_Linear)+      ;+   else+      printf (")");++   if (ftab_Style == ftab_Latex)+      printf ("$");  +   printf ("\n\n");+}+++/*-------------------------------------------------------------------------*/++static double ChooseSample (void *vpar, long i, long j)+{+   Sample_Param *param = vpar;+   double x, y;+   +   if (swrite_Basic)+      WriteSample (vpar, 0, j);+   x = i * param->a + j * param->b + param->c;+   y = param->F(x);+   return y;+}+++/*-------------------------------------------------------------------------*/++fcho_Cho * fcho_CreateSampleSize (double a, double b, double c,+                                  fcho_FuncType F, char *name)+{+   fcho_Cho *cho;+   Sample_Param *param;   +   size_t len;+   char *name0 = "n";++   cho = util_Malloc (sizeof (fcho_Cho));+   param = util_Malloc (sizeof (Sample_Param));+   param->a = a;+   param->b = b;+   param->c = c;+   if (NULL == F)+      param->F = fcho_2Pow;+   else+      param->F = F;++   if (NULL == name)+      name = name0;+   len = strlen (name);+   cho->name = util_Calloc (len + 1, sizeof (char));+   strncpy (cho->name, name, (size_t) len);+   cho->param = param;+   cho->Write = WriteSample;+   cho->Choose = ChooseSample;+   param->name = cho->name;+   return cho;+}+++/*-------------------------------------------------------------------------*/++void fcho_DeleteSampleSize (fcho_Cho *cho)+{+   if (NULL == cho)+      return;+   cho->name = util_Free (cho->name);+   cho->param = util_Free (cho->param);+   util_Free (cho);+}+++/*=========================================================================*/++long fcho_ChooseParamL (fcho_Cho *cho, long min, long max, long i, long j)+{+   double n;++   util_Assert (cho, "fcho_ChooseParamL:   cho is NULL");+   n = cho->Choose (cho->param, i, j);++   if (n < min) {+      if (cho->name)+         printf ("%s < %ld\n\n", cho->name, min);+      return -1;+   }+   if (n > max) {+      if (cho->name)+         printf ("%s > %ld\n\n", cho->name, max);+      return -1;+   }+   return (long) n;+}+++/*=========================================================================*/++int fcho_Chooses (int r, int s, int prec)+{+   int s1;++   if (r + s <= prec)+      return s;++   s1 = prec - r;+   if (s1 <= 0)+      printf ("r >= Resolution of generator\n\n");++   return s1;+}+++/*=========================================================================*/++fcho_Cho2 * fcho_CreateCho2 (fcho_Cho *Chon, fcho_Cho *Chop2)+{+   fcho_Cho2 *cho;+   cho = util_Malloc (sizeof (fcho_Cho2));+   memset (cho, 0, sizeof (fcho_Cho2));+   cho->Chon = Chon;+   cho->Chop2 = Chop2;+   return cho;+}++/*-------------------------------------------------------------------------*/++void fcho_DeleteCho2 (fcho_Cho2 *cho)+{+   if (NULL == cho)+      return;+   util_Free (cho);+}++/*=========================================================================*/
+ cbits/testu/src/fdist.c view
@@ -0,0 +1,3585 @@+/*************************************************************************\+ *+ * Package:        ProbDist+ * File:           fdist.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "fdist.h"+#include "fmass.h"+#include "fbar.h"++#include "num.h"+#include "num2.h"+#include "util.h"+#include "tables.h"++#include <stddef.h>+#include <limits.h>+#include <float.h>+#include <math.h>+++double fdist_belog (double);+void fdist_CalcB4 (double, double *, double *, double *, double *);+static double Pomeranz (long n, double x);+++const double fdist_XINF  = DBL_MAX; /* x infinity for some distributions */+const double fdist_XBIG  = 100.0;   /* x infinity for some distributions */+const double fdist_XBIGM = 1000.0;  /* x infinity for some distributions */++/* EpsArray[j]: Epsilon required for j decimal degits of precision */+static const double EpsArray[] = {+   0.5, 0.5E-1, 0.5E-2, 0.5E-3, 0.5E-4, 0.5E-5, 0.5E-6, 0.5E-7, 0.5E-8,+   0.5E-9, 0.5E-10, 0.5E-11, 0.5E-12, 0.5E-13, 0.5E-14, 0.5E-15, 0.5E-16,+   0.5E-17, 0.5E-18, 0.5E-19, 0.5E-20, 0.5E-21, 0.5E-22, 0.5E-23, 0.5E-24,+   0.5E-25, 0.5E-26, 0.5E-27, 0.5E-28, 0.5E-29, 0.5E-30, 0.5E-31, 0.5E-32,+   0.5E-33, 0.5E-34, 0.5E-35+};++/* static const double EpsilonLR = 1.0E-15;  */+#define X_EPSILON 1.0e-3          /* For x --> 0 */++#define TWOPI 6.28318530717958647688++++/*-------------------------------------------------------------------------*/++double fdist_belog (double x)+/*+ * This is the function   (1 - x*x + 2*x*log(x)) / ((1 - x)*(1 - x))+ */+{+   if (x > 1.0)+      return -fdist_belog(1.0/x);+   if (x < 1.0e-20)+      return 1.0;+   if (x < 0.9)+      return (1.0 - x * x + 2.0 * x * log (x)) / ((1.0 - x) * (1.0 - x));+   if (x == 1.0)+      return 0.0;+   {+      /* For x near 1, use a series expansion to avoid loss of precision. */+      double term;+      const double EPS = 1.0e-12;+      const double Y = 1.0 - x;+      double ypow = 1.0;+      double sum = 0.0;+      int j = 2;+      do {+         ypow *= Y;+         term = ypow / (j * (j + 1));+         sum += term;+         j++;+      } while (fabs (term / sum) > EPS);++      return 2.0 * sum;+   }+}+++/*=========================================================================*/++double fdist_Unif (double x)+{+   if (x <= 0.0)+      return 0.0;+   if (x >= 1.0)+      return 1.0;+   return x;+}+++/*=========================================================================*/++double fdist_Expon (double x)+{+   if (x <= 0.0)+      return 0.0;+   if (x >= fdist_XBIG)+      return 1.0;+   if (x > X_EPSILON)+      return 1.0 - exp (-x);++   /* Avoid loss of precision for small x */+   return x * (1.0 - x * (0.5 - x*(1.0 / 6.0 - x/24.0)));+}+++/*=========================================================================*/++double fdist_Weibull (double c, double x)+{+   double y;+   util_Assert (c > 0.0, "fdist_Weibull:   c <= 0");+   if (x <= 0.0)+      return 0.0;+   if (x >= fdist_XBIG && c >= 1.0)+      return 1.0;++   y = c*log(x);+   if (y >= 5.0)+      return 1.0;+   y = exp(y);++   if (y > X_EPSILON)+      return (1.0 - exp (-y));++   /* Avoid loss of precision for small y */+   return y * (1.0 - y * (0.5 - y*(1.0/6.0 - y/24.0)));+}+++/*=========================================================================*/++double fdist_ExtremeValue (double x)+{+   if (x <= -10.0)+      return 0.0;+   if (x >= fdist_XBIG)+      return 1.0;+   return exp (-exp (-x));+}+++/*=========================================================================*/++double fdist_Logistic (double x)+{+   if (x <= -fdist_XBIG)+      return exp (x);+   if (x >= fdist_XBIG)+      return 1.0;+   return 1.0 / (1.0 + exp (-x));+}+++/*=========================================================================*/++double fdist_Pareto (double c, double x)+{+   double y = c*log(x);+   util_Assert (c > 0.0, "fdist_Pareto:   c <= 0");+   if (x <= 1.0)+      return 0.0;+   if (y >= 50.0)+      return 1.0;+   y = exp(y);+   return (1.0 - 1.0 / y);+}+++/*=========================================================================*/++double fdist_Normal1 (double x)+/*+ * Returns P[X <= x] for the normal distribution.+ * As in p:90 of W.J.Kennedy Jr and J.E.Gentle. Statistical computing.+ * Dekker, New York, 1980.+ */+{+   static const double Racinedeux = 1.4142135623730950488;+   static const double racineunsurpi = 0.56418958354775628694;++   static const double p10 = 2.4266795523053175e2;+   static const double p11 = 2.1979261618294152e1;+   static const double p12 = 6.9963834886191355;+   static const double p13 = -3.5609843701815385e-2;++   static const double p20 = 3.004592610201616005e2;+   static const double p21 = 4.519189537118729422e2;+   static const double p22 = 3.393208167343436870e2;+   static const double p23 = 1.529892850469404039e2;+   static const double p24 = 4.316222722205673530e1;+   static const double p25 = 7.211758250883093659e0;+   static const double p26 = 5.641955174789739711e-1;+   static const double p27 = -1.368648573827167067e-7;++   static const double p30 = -2.99610707703542174e-3;+   static const double p31 = -4.94730910623250734e-2;+   static const double p32 = -2.26956593539686930e-1;+   static const double p33 = -2.78661308609647788e-1;+   static const double p34 = -2.23192459734184686e-2;++   static const double q10 = 2.1505887586986120e2;+   static const double q11 = 9.1164905404514901e1;+   static const double q12 = 1.5082797630407787e1;+   static const double q13 = 1.0;++   static const double q20 = 3.004592609569832933e2;+   static const double q21 = 7.909509253278980272e2;+   static const double q22 = 9.313540948506096211e2;+   static const double q23 = 6.389802644656311665e2;+   static const double q24 = 2.775854447439876434e2;+   static const double q25 = 7.700015293522947295e1;+   static const double q26 = 1.278272731962942351e1;+   static const double q27 = 1.0;++   static const double q30 = 1.06209230528467918e-2;+   static const double q31 = 1.91308926107829841e-1;+   static const double q32 = 1.05167510706793207e0;+   static const double q33 = 1.98733201817135256e0;+   static const double q34 = 1.0;++   static const double xasymp = 40.0;+   double Ycarre, unsurY2, Y, R, erf;++   if (x < -xasymp)+      return 0.0;+   if (x > xasymp)+      return 1.0;++   if (x < 0.0)+      return 1.0 - fdist_Normal1 (-x);++   Y = x / Racinedeux;+   Ycarre = x * x / 2.0;+   if (Y < 0.447) {+      R = (p10 + Ycarre * (p11 + Ycarre * (p12 + Ycarre * p13))) /+         (q10 + Ycarre * (q11 + Ycarre * (q12 + Ycarre * q13)));+      erf = Y * R;+   } else {+      if (Y <= 4.0) {+         R = (p20 + Y * (p21 + Y * (p22 + Y * (p23 + Y * (p24 + Y * (p25 ++                           Y * (p26 + Y * p27))))))) / (q20 + Y * (q21 ++               Y * (q22 + Y * (q23 + Y * (q24 + Y * (q25 + Y * (q26 ++                              Y * q27)))))));+         if (-Ycarre < DBL_MIN_EXP * num_Ln2)+            erf = 1.0;+         else+            erf = 1.0 - exp (-Ycarre) * R;+      } else {+         double temp;+         unsurY2 = 1.0 / Ycarre;+         R = (p30 + unsurY2 * (p31 + unsurY2 * (p32 + unsurY2 *+                  (p33 + unsurY2 * p34)))) / (q30 + unsurY2 *+            (q31 + unsurY2 * (q32 + unsurY2 * (q33 + unsurY2 * q34))));+         if (-Ycarre < DBL_MIN_EXP * num_Ln2)+            temp = 0.0;+         else+            temp = exp (-Ycarre);+         erf = 1.0 - (temp / Y) * (racineunsurpi + R / Ycarre);+      }+   }+   return ((1.0 + erf) / 2.0);+}+++/**************************************************************************/+/* + * The precision of double is 16 decimals; we shall thus use COEFFMAX = 24+ * coefficients. But the approximation is good to 30 decimals of precision+ * with 44 coefficients.+ */+#define COEFFMAX 24++static const double Normal2_A[44] = {+   6.10143081923200417926465815756e-1,+   -4.34841272712577471828182820888e-1,+   1.76351193643605501125840298123e-1,+   -6.0710795609249414860051215825e-2,+   1.7712068995694114486147141191e-2,+   -4.321119385567293818599864968e-3,+   8.54216676887098678819832055e-4,+   -1.27155090609162742628893940e-4,+   1.1248167243671189468847072e-5,+   3.13063885421820972630152e-7,+   -2.70988068537762022009086e-7,+   3.0737622701407688440959e-8,+   2.515620384817622937314e-9,+   -1.028929921320319127590e-9,+   2.9944052119949939363e-11,+   2.6051789687266936290e-11,+   -2.634839924171969386e-12,+   -6.43404509890636443e-13,+   1.12457401801663447e-13,+   1.7281533389986098e-14,+   -4.264101694942375e-15,+   -5.45371977880191e-16,+   1.58697607761671e-16,+   2.0899837844334e-17,+   -5.900526869409e-18,+   -9.41893387554e-19,+   2.14977356470e-19,+   4.6660985008e-20,+   -7.243011862e-21,+   -2.387966824e-21,+   1.91177535e-22,+   1.20482568e-22,+   -6.72377e-25,+   -5.747997e-24,+   -4.28493e-25,+   2.44856e-25,+   4.3793e-26,+   -8.151e-27,+   -3.089e-27,+   9.3e-29,+   1.74e-28,+   1.6e-29,+   -8.0e-30,+   -2.0e-30+};+++double fdist_Normal2 (double x)+/*+ * Returns P[X < x] for the normal distribution.+ * As in J. L. Schonfelder, Math. of Computation, Vol. 32,+ * pp 1232--1240, (1978).+ */+{+   double t, r;+   if (x <= -fdist_XBIG)+      return 0.0;+   if (x >= fdist_XBIG)+      return 1.0;++   x = -x / num_Rac2;+   if (x < 0) {+      x = -x;+      t = (x - 3.75) / (x + 3.75);+      r = 1.0 - 0.5 * exp (-x * x) * num2_EvalCheby (Normal2_A, COEFFMAX, t);+   } else {+      t = (x - 3.75) / (x + 3.75);+      r = 0.5 * exp (-x * x) * num2_EvalCheby (Normal2_A, COEFFMAX, t);+   }+   return (r);+}+++/*=========================================================================*/+#ifdef HAVE_ERF++double fdist_Normal3 (double x)+{+   return (erfc (-x * num_1Rac2)) / 2.0;+}++#endif+++/*=========================================================================*/++double fdist_Normal4 (double x)+{+   static const double V[121] = {+      1.2533141373155, 1.137490921203605, 1.037824575853727,+      0.951527192071207, 0.8763644564536924, 0.8105337152790306,+      0.7525711790634081, 0.7012808218544303, 0.6556795424187987,+      0.61495459615093, 0.5784303460476312, 0.5455421356582171,+      0.5158156382179634, 0.4888504415275737, 0.4643069280394423,+      0.4418957328326002, 0.4213692292880546, 0.4025146181296722,+      0.3851482907984348, 0.3691112106902635, 0.3542651113297938,+      0.3404893532870847, 0.3276783146905521, 0.31573921586941,+      0.3045902987101033, 0.2941592970402893, 0.284382146748493,+      0.2752018941576065, 0.2665677689682238, 0.2584343943120386,+      0.2507611114439651, 0.243511400615456, 0.2366523829135607,+      0.230154390478801, 0.2239905946538289, 0.2181366833614714,+      0.2125705804420318, 0.2072722008565011, 0.2022232366330547,+      0.1974069692375194, 0.1928081047153158, 0.1884126285076003,+      0.1842076773079702, 0.1801814257143918, 0.1763229857571027,+      0.1726223176578506, 0.1690701504076941, 0.1656579109468773,+      0.1623776608968675, 0.1592220399363674, 0.1561842150339759,+      0.153257834853479, 0.1504369887362691, 0.1477161697413935,+      0.145090241289131, 0.1425544070104023, 0.1401041834530503,+      0.1377353753382303, 0.1354440530967635, 0.1332265324471292,+      0.1310793558044918, 0.1289992753343376, 0.126983237485437,+      0.1250283688553504, 0.1231319632579323, 0.1212914698765462,+      0.119504482399253, 0.1177687290432979, 0.1160820633859823,+      0.1144424559276431, 0.112847986320103, 0.1112968362007359,+      0.1097872825783083, 0.1083176917221132, 0.1068865135106745,+      0.1054922762005562, 0.1041335815795983, 0.1028091004723001,+      0.1015175685681028, 0.1002577825460485, 0.09902859647173194,+      0.09782891844465691, 0.09665770747608191, 0.09551397057921558,+      0.09439676005522439, 0.09330517095996169, 0.09223833873763035,+      0.09119543700877471, 0.09017567550106469, 0.08917829811230435,+      0.08820258109597616, 0.08724783136042988, 0.08631338487354936,+      0.08539860516539227, 0.08450288192189578, 0.08362562966329139,+      0.08276628650136918, 0.08192431297018954, 0.08109919092525536,+      0.08029042250654048, 0.07949752916111721, 0.07872005072144664,+      0.07795754453568722, 0.07720958464664668, 0.07647576101624852,+      0.07575567879261112, 0.07504895761704659, 0.07435523096847724,+      0.07367414554294564, 0.07300536066605566, 0.07234854773633338,+      0.07170338969763433, 0.07106958053885212, 0.07044682481930167,+      0.06983483721825942, 0.06923334210724434, 0.06864207314371742,+      0.06806077288496332, 0.0674891924209997, 0.06692709102543307,+      0.06637423582325017+   };++   int j;+   lebool negatif;+   double t, u, z, h;+   double r, r1, r2, r3, r4, r5, r6, r7, r8;++   if (x <= -fdist_XBIG)+      return 0.0;+   if (x >= fdist_XBIG)+      return 1.0;+   if (x < 0.0) {+      negatif = TRUE;+      x = -x;+   } else {+      negatif = FALSE;+   }+   j = (int) (8.0 * x + 0.5);+   if (j > 120)+      j = 120;+   z = 0.125 * j;+   h = x - z;+   r = V[j];+   r1 = r * z - 1.0;+   r2 = 0.5 * (r + z * r1);+   r3 = (r1 + z * r2) / 3.0;+   r4 = 0.25 * (r2 + z * r3);+   r5 = 0.2 * (r3 + z * r4);+   r6 = (r4 + z * r5) / 6.0;+   r7 = (r5 + z * r6) / 7.0;+   r8 = 0.125 * (r6 + z * r7);+   t = r + h * (r1 + h * (r2 + h * (r3 + h * (r4 + h * (r5 + h * (r6 ++                     h * (r7 + h * r8)))))));+   u = t * exp (-0.5 * x * x - 0.9189385332046727);+   if (negatif)+      return u;+   else+      return 1.0 - u;+}+++/*=========================================================================*/++static double InitBiNormal (double x, double y, double rho)+{+   /* The special cases of the BiNormal */+   if (fabs (rho) > 1.0) {+      util_Error ("fdist_BiNormal:   |rho| > 1");+      return -1.0;+   }+   if (x == 0.0 && y == 0.0)+      return 0.25 + asin(rho)/TWOPI;+   if (rho == 1.0) {+      x = util_Min(x,y);+      return fdist_Normal2 (x);+   }+   if (rho == 0.0) {+      return fdist_Normal2 (x) * fdist_Normal2 (y);+   }+   if (rho == -1.0) {+      if (y <= -x)+         return 0.0;+      else+         return fdist_Normal2 (x) - fdist_Normal2 (-y);+   }+   if ((x <= -fdist_XBIG) || (y <= -fdist_XBIG))+      return 0.0;+   if (x >= fdist_XBIG)+      return fdist_Normal2 (y);+   if (y >= fdist_XBIG)+      return fdist_Normal2 (x);++   return -2.0;+}+++/*=========================================================================*/++double fdist_BiNormal1 (double x, double y, double rho, int ndig)+{+   double a2, ap, b, cn, conex, ex, g2, gh, gk, gw, h2, h4, rr, s1, s2,+      sgn, sn, sp, sqr, t, w2, wh, wk;+   int is = -1;+   int flag = 1;+   const double ah = -x;+   const double ak = -y;+   const double con = num_Pi * num_TENNEGPOW[ndig];+   const double EPSILON = 0.5 * num_TENNEGPOW[ndig];++   util_Assert (ndig <= 15, "fdist_BiNormal1:   ndig > 15");++   b = InitBiNormal (x, y, rho);+   if (b >= 0.0)+      return b;++   gh = fdist_Normal2 (-ah) / 2.0;+   gk = fdist_Normal2 (-ak) / 2.0;++   b = 0;+   rr = (1 - rho) * (1 + rho);+   sqr = sqrt (rr);+   flag = 1;+   if (ah != 0) {+      b = gh;+      if (ah * ak < 0)+         b = b - .5;+      else if (ah * ak == 0) {+         flag = 0;+      }+   } else if (ak == 0) {+      return asin (rho) / TWOPI + .25;+   }+   if (flag)+      b += gk;+   if (ah != 0) {+      flag = 0;+      wh = -ah;+      wk = (ak / ah - rho) / sqr;+      gw = 2 * gh;+      is = -1;+   }++   do {+      if (flag) {+         wh = -ak;+         wk = (ah / ak - rho) / sqr;+         gw = 2 * gk;+         is = 1;+      }+      flag = 1;+      sgn = -1;+      t = 0;+      if (wk != 0) {+         if (fabs (wk) >= 1) {+            if (fabs (wk) == 1) {+               t = wk * gw * (1 - gw) / 2;+               b = b + sgn * t;+               if (is >= 0)+                  break;+               else+                  continue;+            } else {+               sgn = -sgn;+               wh = wh * wk;+               g2 = fdist_Normal2 (wh);+               wk = 1 / wk;+               if (wk < 0)+                  b = b + .5;+               b = b - (gw + g2) / 2 + gw * g2;+            }+         }+         h2 = wh * wh;+         a2 = wk * wk;+         h4 = h2 * .5;+         ex = 0;+         if (h4 < 150.0)+            ex = exp (-h4);+         w2 = h4 * ex;+         ap = 1;+         s2 = ap - ex;+         sp = ap;+         s1 = 0;+         sn = s1;+         conex = fabs (con / wk);+         do {+            cn = ap * s2 / (sn + sp);+            s1 = s1 + cn;+            if (fabs (cn) <= conex)+               break;+            sn = sp;+            sp = sp + 1;+            s2 = s2 - w2;+            w2 = w2 * h4 / sp;+            ap = -ap * a2;+         } while (1);+         t = (atan (wk) - wk * s1) / TWOPI;+         b = b + sgn * t;+      }+      if (is >= 0)+         break;+   } while (ak != 0);++   if (b < EPSILON)+      b = 0;+   if (b > 1)+      b = 1;+   return b;+}+++/*=========================================================================*/++double fdist_BiNormal2 (double dh, double dk, double rho)+{+   const double twopi = 2.0 * num_Pi;+   double W[11][3];+   double X[11][3];+   double h, k, hk, bvn, hs, asr, sn, as, a, b, c, d, sp, rs, ep, bs, xs;+   int i, lg, ng, is;++   bvn = InitBiNormal (dh, dk, rho);+   if (bvn >= 0.0)+      return bvn;+/*+   I have made small changes in Genz's Matlab function to make it compatible+   with module fdist. (R. Simard)+*/++/*+//   Copyright (C) 2005, Alan Genz,  All rights reserved.               +//+//   Redistribution and use in source and binary forms, with or without+//   modification, are permitted provided the following conditions are met:+//     1. Redistributions of source code must retain the above copyright+//        notice, this list of conditions and the following disclaimer.+//     2. Redistributions in binary form must reproduce the above copyright+//        notice, this list of conditions and the following disclaimer in the+//        documentation and/or other materials provided with the distribution.+//     3. The contributor name(s) may not be used to endorse or promote +//        products derived from this software without specific prior written +//        permission.+//   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+//   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +//   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +//   FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +//   COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, +//   INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, +//   BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS +//   OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +//   ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR +//   TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +//   USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+//+//   function p = bvnl( dh, dk, r )+//+//  A function for computing bivariate normal probabilities.+//  bvnl calculates the probability that x < dh and y < dk. +//    parameters  +//      dh 1st upper integration limit+//      dk 2nd upper integration limit+//      r   correlation coefficient+//+//   Author+//       Alan Genz+//       Department of Mathematics+//       Washington State University+//       Pullman, Wa 99164-3113+//       Email : alangenz@wsu.edu+//   This function is based on the method described by +//        Drezner, Z and G.O. Wesolowsky, (1989),+//        On the computation of the bivariate normal inegral,+//        Journal of Statist. Comput. Simul. 35, pp. 101-107,+//    with major modifications for double precision, for |r| close to 1,+//    and for matlab by Alan Genz - last modifications 7/98.+//+//      p = bvnu( -dh, -dk, r );+//      return+//+//   end bvnl+//+//      function p = bvnu( dh, dk, r )+//+//  A function for computing bivariate normal probabilities.+//  bvnu calculates the probability that x > dh and y > dk. +//    parameters  +//      dh 1st lower integration limit+//      dk 2nd lower integration limit+//      r   correlation coefficient+//+//   Author+//       Alan Genz+//       Department of Mathematics+//       Washington State University+//       Pullman, Wa 99164-3113+//       Email : alangenz@wsu.edu+//+//    This function is based on the method described by +//        Drezner, Z and G.O. Wesolowsky, (1989),+//        On the computation of the bivariate normal inegral,+//        Journal of Statist. Comput. Simul. 35, pp. 101-107,+//    with major modifications for double precision, for |r| close to 1,+//    and for matlab by Alan Genz - last modifications 7/98.+//        Note: to compute the probability that x < dh and y < dk, use +//              bvnu( -dh, -dk, r ). +//+*/+   if (fabs (rho) < 0.3) {+      ng = 0;+      lg = 3;+/*       Gauss Legendre points and weights, n =  6 */+      W[1][0] = 0.1713244923791705;+      W[2][0] = 0.3607615730481384;+      W[3][0] = 0.4679139345726904;++      X[1][0] = 0.9324695142031522;+      X[2][0] = 0.6612093864662647;+      X[3][0] = 0.2386191860831970;++   } else if (fabs (rho) < 0.75) {+      ng = 1;+      lg = 6;+/*       Gauss Legendre points and weights, n = 12 */+      W[1][1] = 0.4717533638651177e-1;+      W[2][1] = 0.1069393259953183;+      W[3][1] = 0.1600783285433464;+      W[4][1] = 0.2031674267230659;+      W[5][1] = 0.2334925365383547;+      W[6][1] = 0.2491470458134029;++      X[1][1] = 0.9815606342467191;+      X[2][1] = 0.9041172563704750;+      X[3][1] = 0.7699026741943050;+      X[4][1] = 0.5873179542866171;+      X[5][1] = 0.3678314989981802;+      X[6][1] = 0.1252334085114692;++   } else {+      ng = 2;+      lg = 10;+/*       Gauss Legendre points and weights, n = 20 */+      W[1][2] = 0.1761400713915212e-1;+      W[2][2] = 0.4060142980038694e-1;+      W[3][2] = 0.6267204833410906e-1;+      W[4][2] = 0.8327674157670475e-1;+      W[5][2] = 0.1019301198172404;+      W[6][2] = 0.1181945319615184;+      W[7][2] = 0.1316886384491766;+      W[8][2] = 0.1420961093183821;+      W[9][2] = 0.1491729864726037;+      W[10][2] = 0.1527533871307259;++      X[1][2] = 0.9931285991850949;+      X[2][2] = 0.9639719272779138;+      X[3][2] = 0.9122344282513259;+      X[4][2] = 0.8391169718222188;+      X[5][2] = 0.7463319064601508;+      X[6][2] = 0.6360536807265150;+      X[7][2] = 0.5108670019508271;+      X[8][2] = 0.3737060887154196;+      X[9][2] = 0.2277858511416451;+      X[10][2] = 0.7652652113349733e-1;+   }++   h = -dh;+   k = -dk;+   hk = h * k;+   bvn = 0;+   if (fabs (rho) < 0.925) {+      hs = (h * h + k * k) / 2.0;+      asr = asin (rho);+      for (i = 1; i <= lg; ++i) {+         sn = sin (asr * (1.0 - X[i][ng]) / 2.0);+         bvn += W[i][ng] * exp ((sn * hk - hs) / (1.0 - sn * sn));+         sn = sin (asr * (1.0 + X[i][ng]) / 2.0);+         bvn += W[i][ng] * exp ((sn * hk - hs) / (1.0 - sn * sn));+      }+      bvn =+         bvn * asr / (4.0 * num_Pi) + fdist_Normal2 (-h) * fdist_Normal2 (-k);++   } else {+      if (rho < 0.0) {+         k = -k;+         hk = -hk;+      }+      if (fabs (rho) < 1.0) {+         as = (1.0 - rho) * (1.0 + rho);+         a = sqrt (as);+         bs = (h - k) * (h - k);+         c = (4.0 - hk) / 8.0;+         d = (12.0 - hk) / 16.0;+         asr = -(bs / as + hk) / 2.0;+         if (asr > -100.0)+            bvn =+               a * exp (asr) * (1.0 - c * (bs - as) * (1.0 -+                  d * bs / 5.0) / 3.0 + c * d * as * as / 5.0);++         if (-hk < 100.0) {+            b = sqrt (bs);+            sp = sqrt (twopi) * fdist_Normal2 (-b / a);+            bvn = bvn - exp (-hk / 2.0) * sp * b * (1.0 - c * bs * (1.0 -+                  d * bs / 5.0) / 3.0);+         }+         a = a / 2.0;+         for (i = 1; i <= lg; ++i) {+            for (is = -1; is <= 1; is += 2) {+               xs = (a * (is * X[i][ng] + 1.0));+               xs = xs * xs;+               rs = sqrt (1.0 - xs);+               asr = -(bs / xs + hk) / 2.0;+               if (asr > -100.0) {+                  sp = (1.0 + c * xs * (1.0 + d * xs));+                  ep = exp (-hk * (1.0 - rs) / (2.0 * (1.0 + rs))) / rs;+                  bvn += a * W[i][ng] * exp (asr) * (ep - sp);+               }+            }+         }+         bvn = -bvn / twopi;+      }+      if (rho > 0.0) {+         if (k > h)+            h = k;+         bvn += fdist_Normal2 (-h);+      }+      if (rho < 0.0) {+         xs = fdist_Normal2 (-h) - fdist_Normal2 (-k);+         if (xs < 0.0)+            xs = 0.0;+         bvn = -bvn + xs;+      }+   }+   if (bvn <= 0.0)+      return 0.0;+   if (bvn >= 1.0)+      return 1.0;+   return bvn;+}+++/*=========================================================================*/++double fdist_LogNormal (double mu, double sigma, double x)+{+   util_Assert (sigma > 0.0, "fdist_LogNormal:  sigma  <= 0");+   if (x <= 0.0)+      return 0.0;+   return fdist_Normal2 ((log (x) - mu) / sigma);+}+++/*=========================================================================*/++double fdist_JohnsonSB (double alpha, double beta, double a, double b,+   double x)+{+   util_Assert (beta > 0.0, "fdist_JohnsonSB:  beta  <= 0");+   util_Assert (b > a, "fdist_JohnsonSB:  b  <= a");+   if (x <= a)+      return 0.0;+   if (x >= b)+      return 1.0;+   return fdist_Normal2 (alpha + beta * log ((x - a) / (b - x)));+}+++/*=========================================================================*/++double fdist_JohnsonSU (double alpha, double beta, double x)+{+   const double XLIM = 1.0e10;+   double r;+   lebool negative = FALSE;+   util_Assert (beta > 0.0, "fdist_JohnsonSU:  beta  <= 0");+   if (x < 0.0) {+      negative = TRUE;+      x = -x;+   }+   /* compute r = x + sqrt (x * x + 1) */+   if (x < XLIM)+      r = x + sqrt (x * x + 1.0);+   else+      r = 2.0 * x;+   if (negative)+      r = 1.0 / r;++   if (r > 0.0)+      return fdist_Normal2 (alpha + beta * log (r));+   else+      return 0.0;+}+++/**************************************************************************/++double fdist_ChiSquare1 (long N, double x)+/*+ * Returns an approximation of the Chi square cdf (N degrees of freedom)+ * As in p:116 of W.J.Kennedy Jr and J.E.Gentle. Statistical computing,+ * Dekker, New York, 1980.+ */+{+   const double tiers = 0.33333333333333333;+   const double pt2 = 0.22222222222222222;+   const double moinsdixhuit = -18.8055;+   const double gam = 0.8862269254527579825931;+   double H, H2, E, DemiX, Terme, Sommation, Y = 0;+   long i;++   util_Assert (N > 0, "fdist_ChiSquare1:   k < 1");+   if (x <= 0.0)+      return 0.0;+   if (x >= fdist_XBIG * N)+      return 1.0;++   if (N > 1000) {+      if (x < 2.0)+         return 0.0;+      x = (pow ((x / N), tiers) - (1.0 - pt2 / N)) / sqrt (pt2 / N);+      if (x > 5.0)+         return 1.0;+      if (x < moinsdixhuit)+         return 0.0;+      return fdist_Normal2 (x);++   } else {+      DemiX = x / 2.0;+      if (!(N & 1)) {             /* even N */+         if (-DemiX < DBL_MIN_EXP * num_Ln2)+            Terme = 0.0;+         else+            Terme = exp (-DemiX);+         Sommation = Terme;+         for (i = 1; i < N / 2; i++) {+            Terme = Terme * DemiX / ((double) i);+            Sommation += Terme;+         }+         Y = 1.0 - Sommation;+      } else {+         H2 = -1.0 + 2.0 * fdist_Normal2 (sqrt (x));+         if (N == 1)+            return H2;+         if (-DemiX < DBL_MIN_EXP * num_Ln2)+            E = 0.0;+         else+            E = exp (-DemiX);+         Terme = sqrt (DemiX) * E / gam;+         H = H2;+         for (i = 3; i < N; i += 2) {+            H -= Terme;+            Terme = Terme * DemiX * 2.0 / ((double) i);+         }+         Y = H - Terme;+      }+   }+   if (Y < 0.0)+      return 0.0;+   else+      return Y;+}+++/*=========================================================================*/++double fdist_ChiSquare2 (long n, int d, double x)+{+   util_Assert (n > 0, "fdist_ChiSquare2:   n <= 0");+   if (x <= 0.0)+      return 0.0;+   if (x >= fdist_XBIG * n)+      return 1.0;+   return fdist_Gamma (n / 2.0, d, x / 2.0);+}+++/*=========================================================================*/++#define Student_n1 20+#define Student_x1 8.01+#define Student_kmax 200+#define Student_eps 0.5E-16++double fdist_Student1 (long n, double x)+{+   double a, u, b, y, z, z2, prec;+   long k;++   util_Assert (n > 0, "fdist_Student1:   n <= 0");+   if (n == 1) {+      if (x < -0.5)+         return atan(-1.0/x) / num_Pi;+      return 0.5 + (atan (x)) / num_Pi;+   }++   if (n == 2) {+      z = 1.0 + x * x / 2.0;+      if (x >= 0.)+         return 0.5 + x / (2.0 * sqrt (z) * num_Rac2);+      else+         return 0.25 / (z * (0.5 - x /(2.0*sqrt(z)*num_Rac2)));+   }++   /* first case: small n and small x */+   if (n <= Student_n1 && x <= Student_x1) {+      b = 1.0 + x * x / n;+      y = x / sqrt ((double) n);+      z = 1.0;+      for (k = n - 2; k >= 2; k -= 2) {+         z = 1.0 + z * (k - 1.0) / (k * b);+      }+      if (n % 2 == 0) {+         u = (1.0 + z * y / sqrt (b)) / 2.0;+         if (u >= 0.)+            return u;+         else+            return 0.;+      } else {+         if (y > -1.0)+            return (0.5 + (atan (y) + z * y / b) / num_Pi);+         else {+            u = (atan (-1.0 / y) + z * y / b) / num_Pi;+            if (u >= 0.)+               return u;+            else+               return 0.;+         }+      }++   /* second case: large n and small x */+   } else if (x < Student_x1) {+      a = n - 0.5;+      b = 48.0 * a * a;+      z2 = a * num2_log1p (x * x / n);+      z = sqrt (z2);+      y = (((((64.0 * z2 + 788.0) * z2 + 9801.0) * z2 + 89775.0) * z2 ++            543375.0) * z2 + 1788885.0) * z / (210.0 * b * b * b);+      y -=+         (((4.0 * z2 + 33.0) * z2 + 240.0) * z2 + 855.0) * z / (10.0 * b * b);+      y += z + (z2 + 3.0) * z / b;+      if (x >= 0.0)+         return fbar_Normal1 (-y);+      else+         return fbar_Normal1 (y);++   /* third case: large x */+   } else {+      /* Compute the Student probability density */+      b = 1.0 + x * x / n;+      /* to avoid overflow with the 2 Gamma functions, use their logarithm.+         However, for large n, there will be some loss of precision */+      y = num2_LnGamma ((n + 1) / 2.0) - num2_LnGamma (n / 2.0);+      y = exp (y);+      y *= pow (b, -(n + 1) / 2.0) / sqrt (num_Pi * n);++      y *= 2.0 * sqrt (n * b);+      z = y / n;+      k = 2;+      z2 = prec = 10.0;+      while (k < Student_kmax && prec > Student_eps) {+         y *= (k - 1) / (k * b);+         z += y / (n + k);+         prec = fabs (z - z2);+         z2 = z;+         k += 2;+      }+      util_Warning (k >= Student_kmax, "fdist_Student1: k >= Student_kmax");+      if (x >= 0.0)+         return 1.0 - z / 2.0;+      else+         return z / 2.0;+   }+}++/*=========================================================================*/++double fdist_Student2 (long n, int d, double x)+{+   util_Assert (n > 0, "fdist_Student2:   n <= 0");+   util_Assert (d > 0, "fdist_Student2:   d <= 0");+   util_Assert (d <= 15, "fdist_Student2:   d > 15");+   if (x <= -fdist_XBIG)+      return 0.0;+   if (x >= fdist_XBIG)+      return 1.0;++   if (x >= 0.0)+      return 0.5 * (1.0 + fdist_Beta (0.5, 0.5 * n, d, x * x / (n + x * x)));+   else+      return 0.5 * (fdist_Beta (0.5 * n, 0.5, d, n / (n + x * x)));+}++/*=========================================================================*/++double fdist_Gamma (double alpha, int d, double x)+{+   const double ALIM = 1.0e5;+   const double EPS = EpsArray[d];++   util_Assert (alpha > 0.0, "fdist_Gamma:   a <= 0");+   util_Assert (d > 0, "fdist_Gamma:   d <= 0");+   util_Assert (d < 16, "fdist_Gamma:   d > 15");+   if (x <= 0.0)+      return 0.0;+   if (1.0 == alpha)+      return fdist_Expon (x);++   if (alpha >= ALIM) {+      double d2 = x + 1.0/3.0 - alpha - 0.02/alpha;+      double S = alpha - 1.0/2.0;+      double z = d2 * sqrt((1 + fdist_belog(S/x))/x);+      return fdist_Normal2 (z);+   }++   if (x <= 1.0 || x < alpha) {+      double v, z, an, term;+      v = exp (alpha * log (x) - x - num2_LnGamma (alpha));+      z = 1.0;+      term = 1.0;+      an = alpha;+      do {+         an += 1.0;+         term *= x / an;+         z += term;+      } while (term >= EPS * z);+      return z * v / alpha;++   } else+      return 1.0 - fbar_Gamma (alpha, d, x);+}+++/*=========================================================================*/++static double Isubx_pq_small (double p, double q, double x, int d)+/* + * Evaluates fdist_Beta (p, q, d, x) when 0 < p <= 1 and 0 < q <= 2 to a+ * precision of d = -log10 (2 epsilon) decimal digits. Uses a series+ * expansion in powers of x.+ */+{++   int k = 0;+   double s, u, v;+   double epsilon;+   util_Assert (p > 0.0 && p <= 1.0, "Isubx_pq_small:   p not in (0, 1] ");+   util_Assert (q > 0.0 && q <= 2.0, "Isubx_pq_small:   q not in (0, 2] ");++   epsilon = EpsArray[d];+   u = pow (x, p);+   s = u / p;+   do {+      u = (k + 1 - q) * x * u / (k + 1);+      v = u / (k + 1 + p);+      s += v;+      k++;+   } while ((fabs (v) / s) > epsilon);++   v = num2_LnGamma (p + q) - num2_LnGamma (p) - num2_LnGamma (q);+   return s * exp (v);+}++/*-------------------------------------------------------------------------*/++static void forward (double p, double q, double x, double I0, double I1,+   int nmax, double I[])+/* + * Given I0 = fdist_Beta (p, q, x) and I1 = fdist_Beta (p, q + 1, x),+ * generates fdist_Beta (p, q + n, x) for n = 0, 1, 2, ..., nmax, and+ * stores the result in I.+ */+{++   int n;++   I[0] = I0;+   if (nmax > 0)+      I[1] = I1;+   for (n = 1; n < nmax; n++)+      I[n + 1] = (1 + (n - 1 + p + q) * (1. - x) / (n + q)) * I[n]+         - (n - 1 + p + q) * (1. - x) * I[n - 1] / (n + q);+}++/*-------------------------------------------------------------------------*/++static void backward (double p, double q, double x, double I0, int d,+   int nmax, double I[])+/*+ * Given I0 = fdist_Beta (p, q, x), generates fdist_Beta (p + n, q, x)+ * for n = 0, 1, 2,..., nmax to d significant digits, using a variant of+ * J.C.P. Miller's backward recurrence algorithm. Stores the result in I. + */+{++   int n, nu, m, again, ntab;+   double *Itemp, *Iapprox, *Rr;+   double epsilon, r;++   I[0] = I0;+   if (nmax == 0)+      return;++   epsilon = EpsArray[d];+   nu = 2 * nmax + 5;+   ntab = 64;+   while (ntab <= nu)+      ntab *= 2;++   Rr = (double *) util_Calloc ((size_t) ntab, sizeof (double));+   Iapprox = (double *) util_Calloc ((size_t) ntab, sizeof (double));+   Itemp = (double *) util_Calloc ((size_t) ntab, sizeof (double));++   for (n = 1; n <= nmax; n++)+      Iapprox[n] = 0.0;+   for (n = 0; n <= nmax; n++)+      Itemp[n] = I[n];++   do {+      n = nu;+      r = 0.0;+      do {+         r = (n - 1 + p + q) * x / (n + p + (n - 1 + p + q) * x - (n + p) * r);+         if (n <= nmax)+            Rr[n - 1] = r;+         n--;+      } while (n >= 1);++      for (n = 0; n < nmax; n++)+         Itemp[n + 1] = Rr[n] * Itemp[n];++      again = 0;+      for (n = 1; n <= nmax; n++) {+         if (fabs ((Itemp[n] - Iapprox[n])/Itemp[n]) > epsilon) {+            again++;+            for (m = 1; m <= nmax; m++)+               Iapprox[m] = Itemp[m];+            nu += 5;+            if (ntab <= nu) {+               ntab *= 2;+               Rr = (double *) util_Realloc (Rr, ntab * sizeof (double));+               Iapprox = (double *) util_Realloc (Iapprox, ntab * sizeof (double));+               Itemp = (double *) util_Realloc (Itemp, ntab * sizeof (double));+            }+            break;+         }+      }+   } while (again);++   for (n = 0; n <= nmax; n++)+      I[n] = Itemp[n];+   util_Free (Rr);+   util_Free (Iapprox);+   util_Free (Itemp);+}++/*-------------------------------------------------------------------------*/+static const double RENORM = 1.0e300;++static void Isubx_q_fixed (double p, double q, double x, int d, int nmax,+   double I[])+/* + * Generates fdist_Beta (p + n, q, x), 0 < p <= 1, for n = 0, 1, 2,...,+ * nmax to d significant digits, using procedure backward. First reduces+ * q modulo 1 to q0, where 0 < q0 <= 1.+ */+{++   int m, mmax;+   double s, q0, Iq0, Iq1;+   double *Iq;++   util_Assert (p > 0.0 && p <= 1.0, "Isubx_q_fixed:   p not in (0, 1] ");+   m = (int) q;                   /* integer part of q */+   s = q - m;                     /* fractionnal part of q */+   if (s > 0) {+      q0 = s;+      mmax = m;+   } else {+      q0 = s + 1;+      mmax = m - 1;+   }+   Iq0 = RENORM * Isubx_pq_small (p, q0, x, d);+   if (mmax > 0)+      Iq1 = RENORM * Isubx_pq_small (p, q0 + 1.0, x, d);++   Iq = (double *) util_Calloc ((size_t) mmax + 1, sizeof (double));+   forward (p, q0, x, Iq0, Iq1, mmax, Iq);+   backward (p, q, x, Iq[mmax], d, nmax, I);+   for (m = 0; m <= nmax; m++)+      I[m] /= RENORM;+   util_Free (Iq);+}++/*-------------------------------------------------------------------------*/++static void Isubx_p_fixed (double p, double q, double x, int d, int nmax,+   double I[])+/* + * Generates fdist_Beta (p, q + n, x), 0 < q <= 1, for n = 0, 1, 2,...,+ * nmax to d significant digits, using procedure forward.+ */+{++   int m, mmax;+   double s, p0, I0, Iq0, I1, Iq1;+   double *Ip;++   util_Assert (q > 0.0 && q <= 1.0, "Isubx_p_fixed:   q not in (0, 1] ");++   m = (int) p;                   /* integer part of p */+   s = p - m;                     /* fractionnal part of p */+   if (s > 0) {+      p0 = s;+      mmax = m;+   } else {+      p0 = s + 1;+      mmax = m - 1;+   }+   I0 = RENORM * Isubx_pq_small (p0, q, x, d);+   I1 = RENORM * Isubx_pq_small (p0, q + 1.0, x, d);++   Ip = (double *) util_Calloc ((size_t) mmax + 1, sizeof (double));+   backward (p0, q, x, I0, d, mmax, Ip);+   Iq0 = Ip[mmax];+   backward (p0, q + 1.0, x, I1, d, mmax, Ip);+   Iq1 = Ip[mmax];+   forward (p, q, x, Iq0, Iq1, nmax, I);+   for (m = 0; m <= nmax; m++)+      I[m] /= RENORM;+   util_Free (Ip);+}++/*-------------------------------------------------------------------------*/++static void Beta_q_fixed (double p, double q, double x, int d, int nmax,+   double I[])+{+   int n;+   util_Assert (p > 0.0 && p <= 1.0, "Beta_q_fixed:   p not in (0, 1]");+   util_Assert (q > 0.0, "Beta_q_fixed:   q <= 0");+   util_Assert (nmax >= 0, "Beta_q_fixed:   nmax < 0");+   if (x == 0.0 || x == 1.0) {+      for (n = 0; n <= nmax; n++)+         I[n] = x;+      return;+   }+   if (x <= 0.5)+      Isubx_q_fixed (p, q, x, d, nmax, I);+   else {+      Isubx_p_fixed (q, p, 1.0 - x, d, nmax, I);+      for (n = 0; n <= nmax; n++)+         I[n] = 1.0 - I[n];+   }+}++/*-------------------------------------------------------------------------*/++static void Beta_p_fixed (double p, double q, double x, int d, int nmax,+   double I[])+{+   int n;+   util_Assert (q > 0.0 && q <= 1.0, "Beta_p_fixed:  q not in (0, 1]");+   util_Assert (p > 0.0, "Beta_p_fixed:   p <= 0");+   util_Assert (nmax >= 0, "Beta_p_fixed:  nmax < 0");+   if (x == 0.0 || x == 1.0) {+      for (n = 0; n <= nmax; n++)+         I[n] = x;+      return;+   }+   if (x <= 0.5)+      Isubx_p_fixed (p, q, x, d, nmax, I);+   else {+      Isubx_q_fixed (q, p, 1.0 - x, d, nmax, I);+      for (n = 0; n <= nmax; n++)+         I[n] = 1.0 - I[n];+   }+}+++/*-------------------------------------------------------------------------*/+/*+ * The exact section of fdist_Beta below is very slow for large parameters.+ * It is an old algorithm of Gautschi of 1964. There is an algorithm+ * for fdist_Beta (1994) that is recent and is supposed to be very fast+ * (I MUST write the exact reference for later; I think it may have been in+ * Mathematics of Computations???) + */+double fdist_Beta (double p, double q, int d, double x)+/*+ * I[j] will contain either the values of fdist_Beta (p0 + j, q, d, x),+ * where 0 < p0 <= 1, for j = 0, 1, 2, ..., n,  with p = p0 + n; or the+ * values of fdist_Beta (p, q0 + j, d, x), where 0 < q0 <= 1, for j = 0,+ * 1, 2, ..., n, with q = q0 + n.+ */+{++   const double pqmax = 1000.0;+   const double pqlim = 30.0;+   int n, flag;+   double p0, q0, u, temp, yd, gam, h1, h3, y;+   double *I;++   util_Assert (p > 0.0, "fdist_Beta:   p <= 0");+   util_Assert (q > 0.0, "fdist_Beta:   q <= 0");+   util_Assert (d > 0, "fdist_Beta:   d <= 0");+   util_Assert (d < 16, "fdist_Beta:   d > 15");+   if (x <= 0.0)+      return 0.0;+   if (x >= 1.0)+      return 1.0;++   if (util_Max (p, q) <= pqmax) {+      if (p < q) {+         n = (int) p;             /* integer part of p */+         p0 = p - n;              /* fractionnal part of p */+         if (p0 <= 0.0) {         /* p0 == 0 not allowed */+            p0 = 1.0;+            n--;+         }+         I = (double *) util_Calloc ((size_t) n + 1, sizeof (double));+         Beta_q_fixed (p0, q, x, d, n, I);+         u = I[n];+         util_Free (I);+         /* There may be numerical errors far in the tails giving very small+            negative values instead of 0. */+         if (u <= 0.0)+            return 0.0;+         else if (u <= 1.0)+            return u;+         else+            return 1.0;++      } else {+         n = (int) q;             /* integer part of q */+         q0 = q - n;              /* fractionnal part of q */+         if (q0 <= 0.0) {         /* q0 == 0 not allowed */+            q0 = 1.0;+            n--;+         }+         I = (double *) util_Calloc ((size_t) n + 1, sizeof (double));+         Beta_p_fixed (p, q0, x, d, n, I);+         u = I[n];+         util_Free (I);+         /* There may be numerical errors far in the tails giving very small+            negative values instead of 0. */+         if (u <= 0.0)+            return 0.0;+         else if (u <= 1.0)+            return u;+         else+            return 1.0;+      }+   }++   if ((p > pqmax && q < pqlim) || (q > pqmax && p < pqlim)) {+      /* Bol'shev approximation for large max(p, q) and small min(p, q) */+      if (x > 0.5)+         return 1.0 - fdist_Beta (q, p, d, 1.0 - x);++      if (p < q) {+         u = p;+         p = q;+         q = u;+         flag = 0;+      } else {+         flag = 1;+      }+      u = p + 0.5 * q - 0.5;+      if (!flag)+         temp = x / (2.0 - x);+      else+         temp = (1.0 - x) / (1.0 + x);+      yd = 2.0 * u * temp;+      gam =+         (exp (q * log (yd) - yd - num2_LnGamma (q)) * (2.0 * yd * yd - (q -+               1.0) * yd - (q * q - 1.0))) / (24.0 * u * u);+      if (flag) {+         yd = fbar_Gamma (q, d, yd);+         return yd - gam;+      } else {+         yd = fdist_Gamma (q, d, yd);+         return yd + gam;+      }+   }++   /* Normal approximation of Peizer and Pratt */+   h1 = p + q - 1.0;+   y = 1.0 - x;+   h3 = sqrt ((1.0 + y * fdist_belog ((p - 0.5) / (h1 * x))+         + x * fdist_belog ((q - 0.5) / (h1 * y)))+      / ((h1 + 1.0 / 6.0) * x * y))+      * ((h1 + 1.0 / 3.0 + 0.02 * (1.0 / p + 1.0 / q + 1.0 / (p + q)))+      * x - p + 1.0 / 3.0 - 0.02 / p - 0.01 / (p + q));++   return fdist_Normal2 (h3);++}+++/*=========================================================================*/+#define EPSILON  1.0e-15          /* Tolerance */+#define EPSBETA  0.5e-10          /* < 0.75 sqrt(DBL_EPSILON) */+#define ALPHALIM 100000.0         /* Limiting alpha for normal approx. */+#define MAXJ  2000                /* Max number of terms in series */+#define INV2PI 0.6366197723675813 /* 2 / PI */+#define LOG4  1.38629436111989062 /* Ln(4) */+#define OneRac2  0.70710678118654752     /* 1/sqrt(2) */+#define SQPI_2  0.88622692545275801   /* Sqrt(Pi) / 2 */+#define LOG_SQPI_2 -0.1207822376352453  /* Ln(Sqrt(Pi) / 2) */++++/*------------------------------------------------------------------------*/++static double series1 (double alpha, double x)+/* + * Compute the series for F(x).+ * This series is used for alpha < 1 and x close to 0.+ */+{+   int j;+   double sum, term;+   double poc;+   poc = 1.0;+   sum = 1.0 / alpha;+   j = 1;+   do {+      poc *= x * (j - alpha) / j;+      term = poc / (j + alpha);+      sum += term;+      ++j;+   } while ((term > sum * EPSILON) && (j < MAXJ));++   return sum * pow (x, alpha);+}+++/*------------------------------------------------------------------------*/++static double series2 (double alpha, double y)+/* + * Compute the series for G(y).   y = 0.5 - x.+ * This series is used for alpha < 1 and x close to 1/2.+ */+{+   int j;+   double term, sum;+   double poc;+   const double z = 4.0 * y * y;++   /* Compute the series for G(y) */+   poc = sum = 1.0;+   j = 1;+   do {+      poc *= z * (j - alpha) / j;+      term = poc / (2 * j + 1);+      sum += term;+      ++j;+   } while ((term > sum * EPSILON) && (j < MAXJ));++   return sum * y;+}+++/*------------------------------------------------------------------------*/++static double series3 (double alpha, double x)+/* + * Compute the series for F(x).+ * This series is used for alpha > 1 and x close to 0.+ */+{+   int j;+   double sum, term;+   const double z = -x / (1.0 - x);++   sum = term = 1.0;+   j = 1;+   do {+      term *= z * (j - alpha) / (j + alpha);+      sum += term;+      ++j;+   } while ((fabs (term) > sum * EPSILON) && (j < MAXJ));++   return sum * x;+}+++/*------------------------------------------------------------------------*/++static double series4 (double alpha, double y)+/* + * Compute the series for G(y).   y = 0.5 - x.+ * This series is used for alpha > 1 and x close to 1/2.+ */+{+   int j;+   double term, sum;+   const double z = 4.0 * y * y;++   term = sum = 1.0;+   j = 1;+   do {+      term *= z * (j + alpha - 0.5) / (0.5 + j);+      sum += term;+      ++j;+   } while ((term > sum * EPSILON) && (j < MAXJ));++   return sum * y;+}+++/*-------------------------------------------------------------------------*/++static double Peizer (double alpha, double x)+/*+ * Normal approximation of Peizer and Pratt+ */+{+   const double y = 1.0 - x;+   double z;+   z = sqrt ((1.0 - y * fdist_belog (2.0 * x) - x * fdist_belog (2.0 * y))+      / ((2.0*alpha - 5.0 / 6.0) * x * y)) * +      (2.0*x - 1.0) * (alpha - 1.0 / 3.0 + 0.025 / alpha);++   return fdist_Normal2 (z);+}+++/*------------------------------------------------------------------------*/++void fdist_CalcB4 (double alpha, double *pB, double *plogB, double *pC,+                   double *plogC)+{+   /* Compute Beta(alpha, alpha) and Beta(alpha, alpha)*4^(alpha-1). */+   double temp;++   if (alpha <= EPSBETA) {+      /* For a -> 0, B(a,a) = (2/a)*(1 - 1.645*a^2 + O(a^3)) */+      *pB = 2.0 / alpha;+      *pC = *pB / (4.0*(1.0 - alpha*LOG4));++   } else if (alpha <= 1.0) {+      *plogB = 2.0 * num2_LnGamma (alpha) - num2_LnGamma (2.0*alpha);+      *plogC = *plogB + (alpha - 1.0)*LOG4;+      *pC = exp(*plogC);+      *pB = exp(*plogB);++   } else if (alpha <= 10.0) {+      *plogC = num2_LnGamma (alpha) - num2_LnGamma (0.5 + alpha) + LOG_SQPI_2;+      *plogB = *plogC - (alpha - 1.0)*LOG4;      ++   } else if (alpha <= 200.0) {+      /* Convergent series for Gamma(x + 0.5) / Gamma(x) */+      double term = 1.0;+      double sum = 1.0;+      int i = 1;+      while (term > EPSILON*sum) {+         term *= (i - 1.5)*(i - 1.5) /(i*(alpha + i - 1.5));+         sum += term;+         i++;+      }+      temp = SQPI_2 / sqrt ((alpha - 0.5)*sum);+      *plogC = log(temp);+      *plogB = *plogC - (alpha - 1.0)*LOG4;++   } else {+      /* Asymptotic series for Gamma(a + 0.5) / (Gamma(a) * Sqrt(a)) */+      double u = 1.0 / (8.0*alpha);+      temp = 1.0 + u*(-1.0 + u*(0.5 + u*(2.5 - u*(2.625 + 49.875*u))));+      /* This is 4^(alpha - 1)*B(alpha, alpha) */+      temp = SQPI_2 / (sqrt(alpha) * temp);+      *plogC = log(temp);+      *plogB = *plogC - (alpha - 1.0)*LOG4;+   }+}+++/*------------------------------------------------------------------------*/++double fdist_BetaSymmetric (double alpha, double x)+/* + * Compute the cumulative probability of the symmetrical beta distribution.+ * Returns a negative value on error, otherwise returns u in [0, 1].+ */+{+   double temp, u, logB, logC;+   int isUpper;                   /* True if x > 0.5 */+   double B = 0.;                 /* Beta(alpha, alpha) */+   double C, x0;++   if (alpha <= 0.0) {+      util_Assert (1, "fdist_BetaSymmetric:   p <= 0\n");+      return -1.0;+   }+   if (x <= 0.0) return 0.0;+   if (x >= 1.0) return 1.0;+   if (x == 0.5) return 0.5;+   if (alpha == 1.0) return x;         /* alpha = 1 is the uniform law */+   if (alpha == 0.5)                   /* alpha = 1/2 is the arcsin law */+      return INV2PI * asin(sqrt(x));++   if (alpha > ALPHALIM)+      return Peizer (alpha, x);++   if (x > 0.5) {+      x = 1.0 - x;+      isUpper = 1;+   } else+      isUpper = 0;++   fdist_CalcB4 (alpha, &B, &logB, &C, &logC);++   if (alpha <= 1.0) {+      /* For x = x0, both series use the same number of terms to get the+         required precision */+      if (x > 0.25) {+         temp = -log (alpha);+         if (alpha >= 1.0e-6)+            x0 = 0.25 + 0.005 * temp;+         else+            x0 = 0.13863 + .01235 * temp;+      } else+         x0 = 0.25;++      if (x <= x0)+         u = (series1 (alpha, x)) / B;+      else+         u = 0.5 - (series2 (alpha, 0.5 - x)) / C;++   } else {                       /* 1 < alpha < ALPHALIM */+      if (alpha < 400.0)+         x0 = 0.5 - 0.45 / sqrt(alpha);+      else+         x0 = 0.5 - 1.0 / sqrt(alpha);+      if (x0 < 0.25)+         x0 = 0.25;++      if (x <= x0) {+         temp = (alpha - 1.0) * log (x * (1.0 - x)) - logB;+         u = series3 (alpha, x) * exp(temp) / alpha;++      } else {      +         const double y = 0.5 - x;+         temp = num2_log1p(-4.0*y*y);+         temp = alpha * temp - logC;+         u = 0.5 - (series4 (alpha, y)) * exp(temp);+      }+   }++   if (isUpper)+      return 1.0 - u;+   else+      return u;+}+++/*=========================================================================*/+#define NLIM 20++static double KSSpecial (long n, double x)+{+   /* For nx^2 > 18, fbar_KS(n, x) is smaller than DBL_EPSILON */+   if ((n*x*x >= 18.0) || (x >= 1.0))+      return 1.0;++   if (x <= 0.5 / n)+      return 0.0;++   if (n == 1)+      return 2.0 * x - 1.0;++   if (x <= 1.0 / n) {+      double t = 2.0 * x - 1.0 / n;+      double w;+      if (n <= NLIM) {+         w = num2_Factorial ((int) n);+         return w * pow (t, (double) n); +      }+      w = num2_LnFactorial ((int) n) + n * log (t);+      return exp (w);+   }++   if (x >= 1.0 - 1.0 / n) {+      return 1.0 - 2.0 * pow (1.0 - x, (double) n);+   }++   return -1.0;+}++#undef NLIM+/*-------------------------------------------------------------------------*/++static double Pelz (long n, double x)+{+   /*+      Approximating the Lower Tail-Areas of the Kolmogorov-Smirnov+         One-Sample Statistic,+      Wolfgang Pelz and I. J. Good,+      Journal of the Royal Statistical Society, Series B.+      Vol. 38, No. 2 (1976), pp. 152-156+    */++   const int JMAX = 20;+   const double EPS = 1.0e-10;+   const double C = 2.506628274631001;  /* sqrt(2*Pi) */+   const double C2 = 1.2533141373155001;  /* sqrt(Pi/2) */+   const double PI2 = num_Pi * num_Pi;+   const double PI4 = PI2 * PI2;+   const double RACN = sqrt((double)n);+   const double z = RACN*x;+   const double z2 = z * z;+   const double z4 = z2 * z2;+   const double z6 = z4 * z2;+   const double w = PI2 / (2.0 * z*z);+   double ti, term, tom;+   double sum;+   int j;++   term = 1;+   j = 0;+   sum = 0;+   while (j <= JMAX && term > EPS * sum) {+      ti = j + 0.5;+      term = exp (-ti * ti * w);+      sum += term;+      j++;+   }+   sum *= C / z;++   term = 1;+   tom = 0;+   j = 0;+   while (j <= JMAX && fabs(term) > EPS * fabs(tom)) {+      ti = j + 0.5;+      term = (PI2 * ti * ti - z2) * exp (-ti * ti * w);+      tom += term;+      j++;+   }+   sum += tom * C2 / (RACN * 3.0 * z4);++   term = 1;+   tom = 0;+   j = 0;+   while (j <= JMAX && fabs(term) > EPS * fabs(tom)) {+      ti = j + 0.5;+      term = 6*z6 + 2*z4 + PI2*(2*z4 - 5*z2)*ti*ti ++             PI4*(1 - 2*z2)*ti*ti*ti*ti;+      term *= exp (-ti * ti * w);+      tom += term;+      j++;+   }+   sum += tom * C2 / (n * 36.0 * z * z6);++   term = 1;+   tom = 0;+   j = 1;+   while (j <= JMAX && term > EPS * tom) {+      ti = j;+      term = PI2 * ti * ti * exp (-ti * ti * w);+      tom += term;+      j++;+   }+   sum -= tom * C2 / (n * 18.0 * z * z2);++   term = 1;+   tom = 0;+   j = 0;+   while (j <= JMAX && fabs(term) > EPS * fabs(tom)) {+      ti = j + 0.5;+      ti = ti * ti;+      term = -30*z6 -90*z6*z2 + PI2*(135*z4 - 96*z6)*ti ++         PI4*(212*z4 - 60*z2)*ti*ti + PI2*PI4*ti*ti*ti*(5 - 30*z2);+      term *= exp (-ti * w);+      tom += term;+      j++;+   }+   sum += tom * C2 / (RACN * n * 3240.0 * z4 * z6);++   term = 1;+   tom = 0;+   j = 1;+   while (j <= JMAX && fabs(term) > EPS * fabs(tom)) {+      ti = j*j;+      term = (3*PI2 * ti * z2 - PI4*ti*ti) * exp (-ti * w);+      tom += term;+      j++;+   }+   sum += tom * C2 / (RACN * n * 108.0 * z6);++   return sum;+}+++/*=========================================================================*/++static void mMultiply (double *A, double *B, double *C, int m)+{+   int i, j, k;+   double s;+   for (i = 0; i < m; i++)+      for (j = 0; j < m; j++) {+         s = 0.0;+         for (k = 0; k < m; k++)+            s += A[i * m + k] * B[k * m + j];+         C[i * m + j] = s;+      }+}+++/*-------------------------------------------------------------------------*/++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 (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)] > 1.0e140) {+      for (i = 0; i < m * m; i++)+         V[i] = V[i] * 1.0e-140;+      *eV += 140;+   }+   free (B);+}+++/*-------------------------------------------------------------------------*/++double fdist_KS2 (long N0, double x)+{+   int k, m, i, j, g, eH, eQ;+   const int n = N0;+   const double d = x;+   double h, s, *H, *Q;++   /* OMIT NEXT 3 LINES IF YOU REQUIRE >7 DIGIT ACCURACY IN THE RIGHT TAIL */+#if 1+   s = d * d * n;+   if (s > 7.24 || (s > 3.76 && n > 99))+      return 1 - 2 * exp (-(2.000071 + 0.331 / sqrt ((double) 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 * i / n;+      if (s < 1.0e-140) {+         s *= 1.0e140;+         eQ -= 140;+      }+   }+   s *= pow (10.0, (double) eQ);+   free (H);+   free (Q);+   return s;+}+++/*=========================================================================*/++static double Pomeranz (long n, double x)+{+   const double EPS = 5.0e-13;   /* for floors and ceilings */+   const int ENO = 350;+   const double RENO = ldexp(1.0, ENO);   /* for renormalization of V */+   const double IRENO = 1.0/RENO;+   int coreno;               /* counter: how many renormalizations */+   const double t = n*x;+   double sum, maxsum;+   int i, j, k, s;+   int r1, r2;                   /* Indices i and i-1 for V[i][] */+   int jlow, jup, klow, kup, kup0;+   double w, z;+   double *A;+   double **V;+   double **H;   /* work variables = pow(w, j-k) / Factorial(j-k) */++   A = (double*) util_Calloc ((size_t) (2*n + 3), sizeof (double));+   V = (double **) tables_CreateMatrixD (2, n + 2);+   H = (double **) tables_CreateMatrixD (4, n + 1);++   A[0] = A[1] = 0;+   z = t - floor(t);+   w = ceil(t) - t;+   if (w < z)+      z = w;+   A[2] = z;+   A[3] = 1.0 - A[2];+   for (i = 4; i <= 2*n + 1; i++)+      A[i] = A[i-2] + 1.0;+   A[2*n + 2] = n;++   for (j = 1; j <= n+1; j++)+      V[0][j] = 0;+   for (j = 2; j <= n+1; j++)+      V[1][j] = 0;+   V[1][1] = RENO;+   coreno = 1;++   /* Precompute H[][] = (A[j] - A[j-1]^(j-k) / (j-k)! for speed */+   H[0][0] = 1;+   w = 2.0 * A[2] / n;+   for (j = 1; j <= n; j++)+      H[0][j] = w * H[0][j - 1] / j;++   H[1][0] = 1;+   w = (1.0 - 2.0*A[2])/n;+   for (j = 1; j <= n; j++)+      H[1][j] = w*H[1][j-1] / j;++   H[2][0] = 1;+   w = A[2]/n;+   for (j = 1; j <= n; j++)+      H[2][j] = w*H[2][j-1] / j;++   H[3][0] = 1;+   for (j = 1; j <= n; j++)+      H[3][j] = 0;++   r1 = 0;+   r2 = 1;+   for (i = 2; i <= 2 * n + 2; i++) {+      jlow = 2 + floor (A[i] - t + EPS);+      if (jlow < 1)+         jlow = 1;+      jup = ceil (A[i] + t - EPS);+      if (jup > n + 1)+         jup = n + 1;++      klow = 2 + floor (A[i - 1] - t + EPS);+      if (klow < 1)+         klow = 1;+      kup0 = ceil (A[i - 1] + t - EPS);++      /* Find to which case it corresponds */+      w = (A[i] - A[i-1])/n;+      s = -1;+      for (j = 0; j < 4; j++) {+         if (fabs(w - H[j][1]) <= EPS) {+            s = j;+            break;+         }+      }+      util_Assert (s >= 0, "Pomeranz:   s < 0");++      maxsum = -1;+      r1 = (r1 + 1) & 1;    /* i - 1  */+      r2 = (r2 + 1) & 1;    /* i */++      for (j = jlow; j <= jup; j++) {+         kup = kup0;+         if (kup > j)+            kup = j;+         sum = 0;+         for (k = kup; k >= klow; k--)+            sum += V[r1][k] * H[s][j - k];+         V[r2][j] = sum;+         if (sum > maxsum)+            maxsum = sum;+      }++      if (maxsum < IRENO) {+         /* V is too small: renormalize to avoid underflow of prob */+         for (j = jlow; j <= jup; j++)+            V[r2][j] *= RENO;+         coreno++;    /* keep track of log of RENO */+      }+   }++   z = V[r2][n+1];+   util_Free (A);+   tables_DeleteMatrixD (&H);+   tables_DeleteMatrixD (&V);++   w = num2_LnFactorial(n) - coreno*ENO*num_Ln2 + log(z);+   if (w >= 0.)+      return 1.;+   return exp(w);+}+++/*-------------------------------------------------------------------------*/+#define NSEP  400+#define NSEP2 4000+#define ZSEP  4.0+#define ZSEP2 0.2++double fdist_KS1 (long n, double x)+{+   double u = KSSpecial(n, x);+   if (u >= 0.0)+      return u;++   if (n <= NSEP) {+      if (n*x*x < ZSEP)+         return Pomeranz (n, x);+      else +         return 1. - fbar_KS1(n, x);+   }++   if (n*x*x <= ZSEP2 && n <= NSEP2)+      return Pomeranz (n, x);++   return Pelz (n, x);+}+++/*=========================================================================*/++double fdist_KSPlus (long N, double x)+{+   const double NxParam = 6.5;    /* frontier: alternating series */+   const long NParam = 4000;      /* frontier: non-alternating series */+   double q;+   double Sum;+   double term;++   util_Assert (N > 0, "Calling fdist_KSPlus with N < 1");+   if (x <= 0.0)+      return 0.0;+   if ((x >= 1.0) || (N*x*x >= 25.0))+      return 1.0;+   if (N == 1)+      return x;++   /*--------------------------------------------------------------*/+   /* the alternating series is stable and fast for N*x very small */+   /*--------------------------------------------------------------*/++   if (N * x <= NxParam) {+      const double Epsilon = 1.0E-300;+      double LogCom = log ((double) N);+      int Sign = -1;+      long j;+      long jmax = (long) (N * x);+      Sum = 0.0;++      for (j = 1; j <= jmax; j++) {+         double jreal = j;+         double Njreal = N - j;+         q = jreal / N - x;+         /* we must avoid log(0.0) for j = jmax and N*x near an integer */+         if (-q > Epsilon) {+            term = LogCom + jreal * log (-q) + (Njreal - 1.0) * num2_log1p (-q);+            Sum += Sign * exp (term);+         }+         Sign = -Sign;+         LogCom += log (Njreal / (j + 1));+      }+      /* add the term j = 0 */+      Sum += exp ((N - 1) * num2_log1p (x));+      if (Sum >= 0.0)+         return Sum * x;+      else+         return 0.0;+   }++   if (N <= NParam) {+      double Njreal;+      double jreal;+      long j;+      long jmax;+      double LogCom = log ((double) N);+      Sum = 0.0;+      jmax = (long) (N * (1.0 - x));+      if (1.0 - x - (double) jmax/N <= 0.0)+         --jmax;++      for (j = 1; j <= jmax; j++) {+         jreal = j;+         Njreal = N - j;+         q = jreal / N + x;+         term = LogCom + (jreal - 1.0) * log (q) + Njreal * num2_log1p(-q);+         Sum += exp (term);+         LogCom += log (Njreal / (jreal + 1.0));+      }+      Sum *= x;++      /* add the term j = 0; avoid log(0.0) */+      if (1.0 > x)+         Sum += exp (N * num2_log1p(-x));+      Sum = 1.0 - Sum;+      if (Sum >= 0.0)+         return Sum;+      else+         return 0.0;+   }++   /*---------------------------*/+   /* Use an asymptotic formula */+   /*---------------------------*/++   term = 2.0 / 3.0;+   q = x * x * N;+   Sum = 1.0 - exp (-2.0 * q) * (1.0 - term * x * (1.0 - x * (1.0 - term * q)+                    - term / N * (0.2 - 19.0 / 15.0 * q + term * q * q)));+   if (Sum >= 0.0)+      return Sum;+   else+      return 0.0;+}+++/*=========================================================================*/++double fdist_KSPlusJumpOne (long N, double a, double x)+{+   const double EpsilonLR = 1.E-15;+   const double Epsilon = 1.0E-290;+   const double NxaParam = 6.5;   /* frontier: alternating series */+   double LogCom;+   double q, p1, q1;+   double Sum = 0.0;+   double term;+   double Njreal;+   double jreal;+   int Sign;+   long j;+   long jmax;++   util_Assert (N >= 1, "Calling fdist_KSPlusJumpOne with N < 1");+   util_Assert (a < 1.0 && a > 0.0,+      "Calling fdist_KSPlusJumpOne with a outside (0, 1)");+   if (x <= 0.0)+      return 0.0;+   if (x + a >= 1.0)+      return 1.0;+   LogCom = log ((double) N);++   /*--------------------------------------------------------------------*/+   /* the alternating series is stable and fast for N*(x + a) very small */+   /*--------------------------------------------------------------------*/+   if (N * (x + a) < NxaParam && a + x < 0.5) {+      jmax = (long) (N * (x + a));+      for (j = 1; j <= jmax; j++) {+         jreal = j;+         Njreal = N - j;+         q = jreal / N - x;+         if ((q < 0.0 && (j & 1)) || ((q > 1.0) && ((N - j - 1) & 1)))+            Sign = -1;+         else+            Sign = 1;++         /* we must avoid log(0.0) */+         q1 = fabs (q);+         p1 = fabs (1.0 - q);+         if (q1 > Epsilon && p1 > Epsilon) {+            term = LogCom + jreal * log (q1) + (Njreal - 1.0) * log (p1);+            Sum += Sign * exp (term);+         }+         LogCom += log (Njreal / (jreal + 1.0));+      }+      /* add the term j = 0 */+      Sum += exp ((N - 1) * num2_log1p(x));+      return Sum * x;+   }++   /*---------------------------------------------*/+   /* For N(x + a) >= NxaParam or (a + x) > 0.5, */+   /* use the non-alternating series.  */+   /*---------------------------------------------*/++   /* EpsilonLR because the distribution has a jump */+   jmax = (long) (N * (1.0 - a - x - EpsilonLR));+   for (j = 1; j <= jmax; j++) {+      jreal = j;+      Njreal = N - jreal;+      q = jreal / N + x;+      if (1.0 - q > Epsilon) {+         term = LogCom + (jreal - 1.0) * log (q) + Njreal * num2_log1p (-q);+         Sum += exp (term);+      }+      LogCom += log (Njreal / (jreal + 1.0));+   }+   Sum *= x;++   /* add the term j = 0 */+   if (1.0 - x > Epsilon)+      Sum += exp (N * num2_log1p (-x));+   return 1.0 - Sum;+}+++/*=========================================================================*/+#if 0+static lebool IsJump (fdist_FUNC_JUMPS * H, double xa, double xb,+   double ya, double yb, int NJ)+   /* Find a more precise value for the position of the jump in (xa, xb). */+   /* Return FALSE if there is no jump, TRUE if there is a jump. */+{+   const double eps = DBL_EPSILON;+   const int imax = DBL_MANT_DIG;+   const double epsY = H->epsY;+   double *par = H->par;+   wdist_CFUNC F = H->F;+   int i = 0;+   double x = 1.0, y;++   /* Binary search to refine the x-coordinate of the jump */+   while ((i < imax) && (xb - xa > eps * x)) {+      i++;+      x = (xb + xa) / 2.0;+      y = F (par, x);+      if (y - ya > epsY) {+         yb = y;+         xb = x;+      } else {+         ya = y;+         xa = x;+      }+   }++   if (yb - ya < epsY)+      return FALSE;+   H->xJump[NJ] = (xb + xa) / 2.0;+   H->yLeftJump[NJ] = ya;+   H->yRightJump[NJ] = yb;+   return TRUE;+}++/*-------------------------------------------------------------------------*/++void fdist_FindJumps (fdist_FUNC_JUMPS * H, int Detail)+{+   int i, NJ;+   double yRight;+   double yLeft;+   double x;+   const double epsX = H->epsX;+   const double epsY = H->epsY;+   double *par = H->par;+   wdist_CFUNC F = H->F;++   /* Assume no more than 30 jumps initially */+   NJ = 30;+   H->xJump = (double *) util_Calloc ((size_t) NJ + 1, sizeof (double));+   H->yLeftJump = (double *) util_Calloc ((size_t) NJ + 1, sizeof (double));+   H->yRightJump = (double *) util_Calloc ((size_t) NJ + 1, sizeof (double));++   i = 0;+   if (H->xa > H->xb) {+      x = H->xa;+      H->xa = H->xb;+      H->xb = x;+   }+   x = H->xa;+   yLeft = F (par, x);+   while (x < H->xb) {+      x += epsX;+      yRight = F (par, x);+      if (yRight - yLeft > epsY) {+         /* this should be a jump */+         ++i;+         if (i > NJ) {+            NJ *= 2;+            H->xJump = (double *) util_Realloc (H->xJump,+               (NJ + 1) * sizeof (double));+            H->yLeftJump = (double *) util_Realloc (H->yLeftJump,+               (NJ + 1) * sizeof (double));+            H->yRightJump = (double *) util_Realloc (H->yRightJump,+               (NJ + 1) * sizeof (double));+         }+         if (IsJump (H, x - epsX, x, yLeft, yRight, i) == FALSE)+            i--;+      }+      yLeft = yRight;+   }+   NJ = i;+   H->xJump = (double *) util_Realloc (H->xJump, (NJ + 1) * sizeof (double));+   H->yLeftJump = (double *) util_Realloc (H->yLeftJump,+                  (NJ + 1) * sizeof (double));+   H->yRightJump = (double *) util_Realloc (H->yRightJump,+                  (NJ + 1) * sizeof (double));+   H->NJumps = NJ;++   if (Detail > 0) {+      printf ("\n=========================================================");+      printf ("\nCalling fdist_FindJumps for function  %-32s\n", H->doc);+      printf ("\nInterval = (%g, %g)\n", H->xa, H->xb);+      printf ("epsX = %10.5g\nepsY = %10.5g\n", epsX, epsY);+      printf ("Number of jumps = %4d\n", NJ);+      if (NJ == 0)+         return;+      printf ("Jumps of the function:\n\n");+      printf ("           x                   yLeft              yRight"+         "         yRight - yLeft\n\n");+      for (i = 1; i <= NJ; i++) {+         printf (" %19.15g %19.15g %19.15g %19.15g\n", H->xJump[i],+            H->yLeftJump[i], H->yRightJump[i],+            H->yRightJump[i] - H->yLeftJump[i]);+      }+      printf+         ("\n=========================================================\n\n");+   }+}+++/*=========================================================================*/++void fdist_FreeJumps (fdist_FUNC_JUMPS * H)+{+   util_Free (H->xJump);+   util_Free (H->yLeftJump);+   util_Free (H->yRightJump);+}+++/*=========================================================================*/++double fdist_KSMinusJumpsMany (fdist_FUNC_JUMPS * H, double dMoins)+{+   int k, j, i, jsup;+   double comb, temp, y;+   double *C, *B;+   const int M = H->par[0];+   const int NJ = H->NJumps;++   util_Assert (M <= 64, "fdist_KSMinusJumpsMany:   sample N too large");+   jsup = M * (1.0 - dMoins - EpsilonLR);+   util_Assert (jsup >= 0, "fdist_KSMinusJumpsMany:  jsup < 0");+   B = (double *) util_Calloc ((size_t) jsup + 1, sizeof (double));+   C = (double *) util_Calloc ((size_t) jsup + 1, sizeof (double));++   j = 0;+   while (j <= jsup) {+      y = dMoins + ((double) j) / M;+      i = 1;+      while (i <= NJ && y > H->yRightJump[i])+         ++i;+      /* I believe that Conover is wrong here, because this gives a */+      /* distribution that is continuous on the left, while probability */+      /* distributions must be continuous on the right. That could be */+      /* why these KS distributions with jumps don't seem to work.  */+      /* I may also have some bugs in these functions.  */++      if (i > NJ || y < H->yLeftJump[i])+         C[j] = 1.0 - y;+      else+         C[j] = 1.0 - H->yRightJump[i];+      ++j;+   }++   B[0] = 1.0;+   for (k = 1; k <= jsup; k++) {+      if (C[k] <= 0.0)+         B[k] = 0.0;+      else {+         temp = 0.0;+         comb = 1.0;+         for (j = 0; j < k; j++) {+            temp += comb * B[j] * pow (C[j], (double) (k - j));+            comb *= ((double) (k - j)) / (j + 1);+         }+         B[k] = 1.0 - temp;+      }+   }+   temp = 0.0;+   comb = 1.0;+   for (j = 0; j <= jsup; j++) {+      temp += comb * B[j] * pow (C[j], (double) (M - j));+      comb *= ((double) (M - j)) / (j + 1);+   }+   util_Warning (temp > 1.0 || temp < 0.0,+      "fdist_KSMinusJumpsMany:   Probabilities outside [0, 1]");+   util_Free (C);+   util_Free (B);+   return temp;+}+++/*=========================================================================*/++double fdist_KSPlusJumpsMany (fdist_FUNC_JUMPS * H, double dPlus)+{+   int k, j, i, jsup;+   double comb, temp, y;+   double *F, *E;+   const int M = H->par[0];+   const int NJ = H->NJumps;++   util_Assert (M <= 64, "fdist_KSPlusJumpsMany:   sample N too large");+   jsup = M * (1.0 - dPlus - EpsilonLR);+   util_Assert (jsup >= 0, "fdist_KSPlusJumpsMany:  jsup < 0");+   E = (double *) util_Calloc ((size_t) jsup + 1, sizeof (double));+   F = (double *) util_Calloc ((size_t) jsup + 1, sizeof (double));++   j = 0;+   while (j <= jsup) {+      y = (1.0 - dPlus) - ((double) j) / M;+      i = 1;+      while (i <= NJ && y >= H->yRightJump[i])+         ++i;++      if (i > NJ || y <= H->yLeftJump[i])+         F[j] = y;+      else+         F[j] = H->yLeftJump[i];+      ++j;+   }++   E[0] = 1.0;+   for (k = 1; k <= jsup; k++) {+      if (F[k] <= 0.0)+         E[k] = 0.0;+      else {+         temp = 0.0;+         comb = 1.0;+         for (j = 0; j < k; j++) {+            temp += comb * E[j] * pow (F[j], (double) (k - j));+            comb *= ((double) (k - j)) / (j + 1);+         }+         E[k] = 1.0 - temp;+      }+   }+   temp = 0.0;+   comb = 1.0;+   for (j = 0; j <= jsup; j++) {+      temp += comb * E[j] * pow (F[j], (double) (M - j));+      comb *= ((double) (M - j)) / (j + 1);+   }+   util_Warning (temp > 1.0 || temp < 0.0,+      "fdist_KSPlusJumpsMany:   Probabilities outside [0, 1]");+   util_Free (E);+   util_Free (F);+   return temp;+}+#endif++/*=========================================================================*/++double fdist_CramerMises (long N, double x)+{+   const double Epsilon = DBL_EPSILON;+   const int jmax = 10;+   int j;+   double Cor, Res, arg;+   double termX, termS, termJ;+   static const double A[10] = {+      1.0,+      1.11803398875,+      1.125,+      1.12673477358,+      1.1274116945,+      1.12774323743,+      1.1279296875,+      1.12804477649,+      1.12812074678,+      1.12817350091+   };++   util_Assert (N > 0, "fdist_CramerMises:   N <= 0");++   if (N == 1) {+      if (x <= 1.0 / 12.0)+         return 0.0;+      if (x >= 1.0 / 3.0)+         return 1.0;+      return 2.0 * sqrt (x - 1.0 / 12.0);+   }++   if (x <= 0.002 || x < 1.0 / (12.0*N))+      return 0.0;+   if (x > 3.95 || x >= N/3.0)+      return 1.0;++   termX = 0.0625 / x;            /* 1 / (16x) */+   Res = 0.0;+   j = 0;+   do {+      termJ = 4 * j + 1;+      arg = termJ * termJ * termX;+      termS = A[j] * exp (-arg) * num2_BesselK025 (arg);+      Res += termS;+      ++j;+   } while (!(termS < Epsilon || j > jmax));++   util_Warning (j > jmax, "fdist_CramerMises: iterations have not converged");+   Res /= num_Pi * sqrt (x);++   /* Empirical correction in 1/N */+   if (x < 0.0092)+      Cor = 0.0;+   else if (x < 0.03)+      Cor = -0.0121763 + x * (2.56672 - 132.571 * x);+   else if (x < 0.06)+      Cor = 0.108688 + x * (-7.14677 + 58.0662 * x);+   else if (x < 0.19)+      Cor = -0.0539444 + x * (-2.22024 + x * (25.0407 - 64.9233 * x));+   else if (x < 0.5)+      Cor = -0.251455 + x * (2.46087 + x * (-8.92836 + x * (14.0988 -+               x * (5.5204 + 4.61784 * x))));+   else if (x <= 1.1)+      Cor = 0.0782122 + x * (-0.519924 + x * (1.75148 ++            x * (-2.72035 + x * (1.94487 - 0.524911 * x))));+   else+      Cor = exp (-0.244889 - 4.26506 * x);++   Res += Cor / N;+   /* This empirical correction is not very precise, so ... */+   if (Res <= 1.0)+      return Res;+   else+      return 1.0;+}+++/*=========================================================================*/++double fdist_WatsonU (long N, double x)+/*+ * Only the asymptotic form has been implemented. In the trivial case+ * N = 1, we simply return 0.5+ */+{+   const int JMAX = 10;+   const double xSepare = 0.15;+   int j;+   double v;+   double terme;+   double somme;++   if (x <= 0.0)+      return 0.0;+   if (x >= fdist_XBIG)+      return 1.0;++   if (N == 1)                    /* N = 1, degenerate case */+      return 0.5;++   if (x > xSepare)+      return 1.0 - fbar_WatsonU (N, x);++   /* this series converges rapidly for x <= 0.15 */+   v = exp (-(0.125 / x));+   somme = v;+   j = 2;+   do {+      terme = pow (v, (double) (2 * j - 1) * (2 * j - 1));+      somme += terme;+      ++j;+   } while (!(terme < v * DBL_EPSILON || j > JMAX));+   util_Warning (j > JMAX, "fdist_WatsonU:  sum2 has not converged");++   v = 2.0 * somme / sqrt (2.0 * num_Pi * x);+   if (v >= 1.0)+      return 1.0;+   return v;+}+++/*=========================================================================*/++static double YWA[143];           /* Tables for a spline approximation */+static double MWA[143];           /* of the WatsonG distribution */+static double CoWA[143];          /* Empirical correction in 1/sqrt(n) */++static void WatsonGInit (void)+/*+ * Initialization procedure for fdist_WatsonG+ */+{+   int j;++   YWA[0] = 1.8121832847E-39;      YWA[1] = 2.0503176304E-32;+   YWA[2] = 4.6139577764E-27;      YWA[3] = 6.5869745929E-23;+   YWA[4] = 1.2765816107E-19;      YWA[5] = 5.6251923105E-17;+   YWA[6] = 8.0747150511E-15;      YWA[7] = 4.8819994144E-13;+   YWA[8] = 1.4996052497E-11;      YWA[9] = 2.6903519441E-10;+   YWA[10] = 3.1322929018E-9;      YWA[11] = 2.5659643046E-8;+   YWA[12] = 1.5749759318E-7;      YWA[13] = 7.6105096466E-7;+   YWA[14] = 3.0113293541E-6;      YWA[15] = 1.0070166837E-5;+   YWA[16] = 2.9199826692E-5;      YWA[17] = 7.4970409372E-5;+   YWA[18] = 1.7340586581E-4;      YWA[19] = 3.6654236297E-4;+   YWA[20] = 7.165864865E-4;       YWA[21] = 1.3087767385E-3;+   YWA[22] = 2.2522044209E-3;      YWA[23] = 3.6781862572E-3;+   YWA[24] = 5.7361958631E-3;      YWA[25] = 8.5877444706E-3;+   YWA[26] = 1.23988738E-2;        YWA[27] = 1.73320516E-2;      +   YWA[28] = 2.35382479E-2;        YWA[29] = 3.11498548E-2;      +   YWA[30] = 4.02749297E-2;        YWA[31] = 5.09930445E-2;      +   YWA[32] = 6.33528333E-2;        YWA[33] = 7.73711747E-2;      +   YWA[34] = 9.30338324E-2;        YWA[35] = 1.10297306E-1;      +   YWA[36] = 1.290916098E-1;       YWA[37] = 1.493236984E-1;     +   YWA[38] = 1.708812741E-1;       YWA[39] = 1.936367476E-1;     +   YWA[40] = 2.174511609E-1;       YWA[41] = 2.42177928E-1;      +   YWA[42] = 2.676662852E-1;       YWA[43] = 2.937643828E-1;     +   YWA[44] = 3.203219784E-1;       YWA[45] = 3.471927188E-1;     +   YWA[46] = 3.742360163E-1;       YWA[47] = 4.013185392E-1;     +   YWA[48] = 4.283153467E-1;       YWA[49] = 4.551107027E-1;     +   YWA[50] = 4.815986082E-1;       YWA[51] = 5.076830902E-1;     +   YWA[52] = 5.332782852E-1;       YWA[53] = 5.583083531E-1;     +   YWA[54] = 5.827072528E-1;       YWA[55] = 6.064184099E-1;     +   YWA[56] = 6.293943006E-1;       YWA[57] = 6.515959739E-1;     +   YWA[58] = 6.729925313E-1;       YWA[59] = 6.935605784E-1;     +   YWA[60] = 7.132836621E-1;       YWA[61] = 7.321517033E-1;     +   YWA[62] = 7.501604333E-1;       YWA[63] = 7.673108406E-1;     +   YWA[64] = 7.836086337E-1;       YWA[65] = 7.99063723E-1;      +   YWA[66] = 8.136897251E-1;       YWA[67] = 8.275034914E-1;     +   YWA[68] = 8.405246632E-1;       YWA[69] = 8.527752531E-1;     +   YWA[70] = 8.642792535E-1;       YWA[71] = 8.750622738E-1;     +   YWA[72] = 8.851512032E-1;       YWA[73] = 8.945739017E-1;     +   YWA[74] = 9.033589176E-1;       YWA[75] = 9.115352296E-1;     +   YWA[76] = 9.19132015E-1;        YWA[77] = 9.261784413E-1;     +   YWA[78] = 9.327034806E-1;       YWA[79] = 9.387357465E-1;     +   YWA[80] = 9.44303351E-1;        YWA[81] = 9.494337813E-1;     +   YWA[82] = 9.541537951E-1;       YWA[83] = 9.584893325E-1;     +   YWA[84] = 9.624654445E-1;       YWA[85] = 9.661062352E-1;     +   YWA[86] = 9.694348183E-1;       YWA[87] = 9.724732859E-1;     +   YWA[88] = 9.752426872E-1;       YWA[89] = 9.777630186E-1;     +   YWA[90] = 9.800532221E-1;       YWA[91] = 9.821311912E-1;     +   YWA[92] = 9.840137844E-1;       YWA[93] = 9.85716844E-1;      +   YWA[94] = 9.872552203E-1;       YWA[95] = 9.886428002E-1;     +   YWA[96] = 9.898925389E-1;       YWA[97] = 9.910164946E-1;     +   YWA[98] = 9.920258656E-1;       YWA[99] = 9.929310287E-1;     +   YWA[100] = 9.937415788E-1;      YWA[101] = 9.944663692E-1;    +   YWA[102] = 9.95113552E-1;       YWA[103] = 9.956906185E-1;    +   YWA[104] = 9.962044387E-1;      YWA[105] = 9.966613009E-1;    +   YWA[106] = 9.970669496E-1;      YWA[107] = 9.974266225E-1;    +   YWA[108] = 9.977450862E-1;      YWA[109] = 9.980266707E-1;+   YWA[110] = 9.982753021E-1;      YWA[111] = 9.984945338E-1;+   YWA[112] = 9.98687576E-1;       YWA[113] = 9.98857324E-1;+   YWA[114] = 9.990063842E-1;      YWA[115] = 9.991370993E-1;+   YWA[116] = 9.992515708E-1;      YWA[117] = 9.99351681E-1;+   YWA[118] = 9.994391129E-1;      YWA[119] = 9.995153688E-1;+   YWA[120] = 9.995817875E-1;      YWA[121] = 9.996395602E-1;+   YWA[122] = 9.996897446E-1;      YWA[123] = 9.997332791E-1;+   YWA[124] = 9.997709943E-1;      YWA[125] = 9.998036243E-1;+   YWA[126] = 9.998318172E-1;      YWA[127] = 9.998561438E-1;+   YWA[128] = 9.998771066E-1;      YWA[129] = 9.998951466E-1;+   YWA[130] = 9.999106508E-1;      YWA[131] = 9.99923958E-1;+   YWA[132] = 9.999353645E-1;      YWA[133] = 9.999451288E-1;+   YWA[134] = 9.999534765E-1;      YWA[135] = 9.999606035E-1;+   YWA[136] = 9.999666805E-1;      YWA[137] = 9.999718553E-1;+   YWA[138] = 9.999762562E-1;      YWA[139] = 9.999799939E-1;+   YWA[140] = 9.999831643E-1;      YWA[141] = 9.999858E-1;+   YWA[142] = 9.999883E-1;++   MWA[0] = 0.0;                MWA[1] = 6.909E-15;    +   MWA[2] = 2.763E-14;          MWA[3] = 1.036E-13;    +   MWA[4] = 3.792E-13;          MWA[5] = 4.773E-12;    +   MWA[6] = 4.59E-10;           MWA[7] = 2.649E-8;     +   MWA[8] = 7.353E-7;           MWA[9] = 1.14E-5;      +   MWA[10] = 1.102E-4;          MWA[11] = 7.276E-4;    +   MWA[12] = 3.538E-3;          MWA[13] = 0.01342;     +   MWA[14] = 0.04157;           MWA[15] = 0.1088;      +   MWA[16] = 0.2474;            MWA[17] = 0.4999;      +   MWA[18] = 0.913;             MWA[19] = 1.53;        +   MWA[20] = 2.381;             MWA[21] = 3.475;       +   MWA[22] = 4.795;             MWA[23] = 6.3;         +   MWA[24] = 7.928;             MWA[25] = 9.602;       +   MWA[26] = 11.24;             MWA[27] = 12.76;       +   MWA[28] = 14.1;              MWA[29] = 15.18;       +   MWA[30] = 15.98;             MWA[31] = 16.47;       +   MWA[32] = 16.64;             MWA[33] = 16.49;       +   MWA[34] = 16.05;             MWA[35] = 15.35;       +   MWA[36] = 14.41;             MWA[37] = 13.28;       +   MWA[38] = 12.0;              MWA[39] = 10.6;        +   MWA[40] = 9.13;              MWA[41] = 7.618;       +   MWA[42] = 6.095;             MWA[43] = 4.588;       +   MWA[44] = 3.122;             MWA[45] = 1.713;       +   MWA[46] = 0.3782;            MWA[47] = -0.8726;     +   MWA[48] = -2.031;            MWA[49] = -3.091;      +   MWA[50] = -4.051;            MWA[51] = -4.91;       +   MWA[52] = -5.668;            MWA[53] = -6.327;      +   MWA[54] = -6.893;            MWA[55] = -7.367;      +   MWA[56] = -7.756;            MWA[57] = -8.064;      +   MWA[58] = -8.297;            MWA[59] = -8.46;       +   MWA[60] = -8.56;             MWA[61] = -8.602;      +   MWA[62] = -8.591;            MWA[63] = -8.533;      +   MWA[64] = -8.433;            MWA[65] = -8.296;      +   MWA[66] = -8.127;            MWA[67] = -7.93;       +   MWA[68] = -7.709;            MWA[69] = -7.469;      +   MWA[70] = -7.212;            MWA[71] = -6.943;      +   MWA[72] = -6.663;            MWA[73] = -6.378;      +   MWA[74] = -6.087;            MWA[75] = -5.795;      +   MWA[76] = -5.503;            MWA[77] = -5.213;      +   MWA[78] = -4.927;            MWA[79] = -4.646;      +   MWA[80] = -4.371;            MWA[81] = -4.103;      +   MWA[82] = -3.843;            MWA[83] = -3.593;      +   MWA[84] = -3.352;            MWA[85] = -3.12;       +   MWA[86] = -2.899;            MWA[87] = -2.689;      +   MWA[88] = -2.489;            MWA[89] = -2.3;        +   MWA[90] = -2.121;            MWA[91] = -1.952;      +   MWA[92] = -1.794;            MWA[93] = -1.645;      +   MWA[94] = -1.506;            MWA[95] = -1.377;      +   MWA[96] = -1.256;            MWA[97] = -1.144;      +   MWA[98] = -1.041;            MWA[99] = -0.9449;     +   MWA[100] = -0.8564;          MWA[101] = -0.775;   +   MWA[102] = -0.7001;          MWA[103] = -0.6315;  +   MWA[104] = -0.5687;          MWA[105] = -0.5113;  +   MWA[106] = -0.459;           MWA[107] = -0.4114;  +   MWA[108] = -0.3681;          MWA[109] = -0.3289;  +   MWA[110] = -0.2934;          MWA[111] = -0.2614;  +   MWA[112] = -0.2325;          MWA[113] = -0.2064;  +   MWA[114] = -0.183;           MWA[115] = -0.1621;  +   MWA[116] = -0.1433;          MWA[117] = -0.1265;  +   MWA[118] = -0.1115;          MWA[119] = -9.813E-2;+   MWA[120] = -8.624E-2;        MWA[121] = -7.569E-2;+   MWA[122] = -6.632E-2;        MWA[123] = -5.803E-2;+   MWA[124] = -5.071E-2;        MWA[125] = -4.424E-2;+   MWA[126] = -3.855E-2;        MWA[127] = -3.353E-2;+   MWA[128] = -2.914E-2;        MWA[129] = -2.528E-2;+   MWA[130] = -0.0219;          MWA[131] = -1.894E-2;+   MWA[132] = -1.637E-2;        MWA[133] = -1.412E-2;+   MWA[134] = -1.217E-2;        MWA[135] = -1.046E-2;+   MWA[136] = -8.988E-3;        MWA[137] = -7.72E-3;+   MWA[138] = -6.567E-3;        MWA[139] = -5.802E-3;+   MWA[140] = -0.0053;          MWA[141] = -4.7E-4;+   MWA[142] = -4.3E-4;++   for (j = 0; j <= 11; j++)+      CoWA[j] = 0.0;++   CoWA[12] = 1.25E-5;            CoWA[13] = 3.87E-5;      +   CoWA[14] = 1.004E-4;           CoWA[15] = 2.703E-4;     +   CoWA[16] = 6.507E-4;           CoWA[17] = 1.3985E-3;    +   CoWA[18] = 2.8353E-3;          CoWA[19] = 5.1911E-3;    +   CoWA[20] = 8.9486E-3;          CoWA[21] = 1.41773E-2;   +   CoWA[22] = 2.16551E-2;         CoWA[23] = 3.1489E-2;    +   CoWA[24] = 4.34123E-2;         CoWA[25] = 5.78719E-2;   +   CoWA[26] = 7.46921E-2;         CoWA[27] = 9.45265E-2;   +   CoWA[28] = 1.165183E-1;        CoWA[29] = 1.406353E-1;  +   CoWA[30] = 1.662849E-1;        CoWA[31] = 1.929895E-1;  +   CoWA[32] = 2.189347E-1;        CoWA[33] = 2.457772E-1;  +   CoWA[34] = 2.704794E-1;        CoWA[35] = 2.947906E-1;  +   CoWA[36] = 3.169854E-1;        CoWA[37] = 3.377435E-1;  +   CoWA[38] = 3.573555E-1;        CoWA[39] = 3.751205E-1;  +   CoWA[40] = 3.906829E-1;        CoWA[41] = 4.039806E-1;  +   CoWA[42] = 4.142483E-1;        CoWA[43] = 4.22779E-1;   +   CoWA[44] = 4.288013E-1;        CoWA[45] = 4.330353E-1;  +   CoWA[46] = 4.34452E-1;         CoWA[47] = 4.338138E-1;  +   CoWA[48] = 4.31504E-1;         CoWA[49] = 4.272541E-1;  +   CoWA[50] = 4.220568E-1;        CoWA[51] = 4.158229E-1;  +   CoWA[52] = 4.083281E-1;        CoWA[53] = 3.981182E-1;  +   CoWA[54] = 3.871678E-1;        CoWA[55] = 3.755527E-1;  +   CoWA[56] = 3.628823E-1;        CoWA[57] = 3.520135E-1;  +   CoWA[58] = 3.400924E-1;        CoWA[59] = 3.280532E-1;  +   CoWA[60] = 3.139477E-1;        CoWA[61] = 2.997087E-1;  +   CoWA[62] = 2.849179E-1;        CoWA[63] = 2.710475E-1;  +   CoWA[64] = 2.576478E-1;        CoWA[65] = 2.449155E-1;  +   CoWA[66] = 2.317447E-1;        CoWA[67] = 2.193161E-1;  +   CoWA[68] = 2.072622E-1;        CoWA[69] = 1.956955E-1;  +   CoWA[70] = 1.846514E-1;        CoWA[71] = 1.734096E-1;  +   CoWA[72] = 1.622678E-1;        CoWA[73] = 1.520447E-1;  +   CoWA[74] = 1.416351E-1;        CoWA[75] = 1.32136E-1;   +   CoWA[76] = 1.231861E-1;        CoWA[77] = 1.150411E-1;  +   CoWA[78] = 1.071536E-1;        CoWA[79] = 9.9465E-2;    +   CoWA[80] = 9.22347E-2;         CoWA[81] = 8.54394E-2;   +   CoWA[82] = 7.87697E-2;         CoWA[83] = 7.23848E-2;   +   CoWA[84] = 6.6587E-2;          CoWA[85] = 6.15849E-2;        +   CoWA[86] = 5.6573E-2;          CoWA[87] = 5.17893E-2;   +   CoWA[88] = 4.70011E-2;         CoWA[89] = 4.2886E-2;+   CoWA[90] = 3.91224E-2;         CoWA[91] = 3.53163E-2;+   CoWA[92] = 3.20884E-2;         CoWA[93] = 2.92264E-2;+   CoWA[94] = 2.66058E-2;         CoWA[95] = 2.37352E-2;+   CoWA[96] = 2.14669E-2;         CoWA[97] = 1.94848E-2;        +   CoWA[98] = 1.75591E-2;         CoWA[99] = 1.58232E-2;        +   CoWA[100] = 1.40302E-2;        CoWA[101] = 1.24349E-2;       +   CoWA[102] = 1.11856E-2;        CoWA[103] = 9.9765E-3;        +   CoWA[104] = 8.9492E-3;         CoWA[105] = 8.0063E-3;        +   CoWA[106] = 7.1509E-3;         CoWA[107] = 6.3196E-3;        +   CoWA[108] = 5.6856E-3;         CoWA[109] = 5.0686E-3;        +   CoWA[110] = 4.5085E-3;         CoWA[111] = 3.9895E-3;        +   CoWA[112] = 3.4804E-3;         CoWA[113] = 3.0447E-3;        +   CoWA[114] = 2.7012E-3;         CoWA[115] = 2.2984E-3;        +   CoWA[116] = 2.0283E-3;         CoWA[117] = 1.7399E-3;        +   CoWA[118] = 1.5032E-3;         CoWA[119] = 1.3267E-3;        +   CoWA[120] = 1.1531E-3;         CoWA[121] = 9.92E-4;          +   CoWA[122] = 9.211E-4;          CoWA[123] = 8.296E-4;         +   CoWA[124] = 6.991E-4;          CoWA[125] = 5.84E-4;          +   CoWA[126] = 5.12E-4;           CoWA[127] = 4.314E-4;         +   CoWA[128] = 3.593E-4;          CoWA[129] = 3.014E-4;         +   CoWA[130] = 2.401E-4;          CoWA[131] = 2.004E-4;         +   CoWA[132] = 1.614E-4;          CoWA[133] = 1.257E-4;         +   CoWA[134] = 1.112E-4;          CoWA[135] = 9.22E-5;          +   CoWA[136] = 8.77E-5;           CoWA[137] = 6.22E-5;          +   CoWA[138] = 4.93E-5;           CoWA[139] = 3.92E-5;          +   CoWA[140] = 3.15E-5;           CoWA[141] = 1.03E-5;+   CoWA[142] = 9.6E-6;+}+++/*-------------------------------------------------------------------------*/++double fdist_WatsonG (long n, double X)+/*+ * Approximation of the cumulative distribution function of the+ * fdist_WatsonG statistics by the cubic spline function.+ *   Y[.]  - tabular value of the statistic;+ *   M[.]  - tabular value of the first derivative;+ */+{+   static int WatsonFlag = 0;+   const double MinArg = 0.15;+   const double MaxArg = 1.5;+   const double MinTab = 0.1;+   const double Step = 0.01;+   int i, j;+   double Tj;+   double Ti;+   double R;+   double P;+   double H;+   double Res;++   util_Assert (n > 0, "fdist_WatsonG:   N <= 0");++   if (n == 1)                    /* n = 1, degenerate case */+      return 0.5;++   if (!WatsonFlag) {+      /* Initialization of the interpolation table */+      WatsonGInit ();+      WatsonFlag = 1;+   }++   if (X <= MinArg)+      return 0.0;+   if (X >= 10.0)+      return 1.0;+   if (X > MaxArg) {+      R = exp (19.0 - 20.0 * X);+      Res = 1.0 - R;+      /* Empirical Correction in 1/sqrt(n) */+      R = exp (13.34 - 15.26 * X) / sqrt ((double) n);+      Res += R;+      /* The correction in 1/sqrt(n) is not always precise */+      if (Res >= 1.0)+         return 1.0;+      else+         return Res;+   }++   /* Search of the correct slot in the interpolation table */+   i = (int) ((X - MinTab) / Step) + 1;+   Ti = MinTab + i * Step;+   Tj = Ti - Step;+   /* Approximation within the slot */+   j = i - 1;+   H = X - Tj;+   R = Ti - X;+   P = Step * Step / 6.0;+   Res = ((MWA[j] * R * R * R + MWA[i] * H * H * H) / 6.0) / Step;+   Res += ((YWA[j] - MWA[j] * P) * R + (YWA[i] - MWA[i] * P) * H) / Step;++   /* Empirical correction in 1/sqrt(n) */+   Res += (CoWA[i] * H + CoWA[j] * R) / (Step * sqrt ((double) n));++   if (Res >= 1.0)+      return 1.0;+   return Res;+}+++/*=========================================================================*/+#define AD_X0 0.38629436111989062+#define AD_X1 37.816242111357++static double AD_N_1 (double x)+{+   /* The Anderson-Darling distribution for N = 1 */+   double term;+   if (x <= AD_X0)+      return 0.0;+   if (x >= AD_X1)+      return 1.0;+   if (x - AD_X0 >= 1.0e-3)+      term = 1.0 - 4.0 * exp (-x - 1.0);+   else {+      const double q = x - AD_X0;+      term = q*(1.0 - q*(0.5 - q/6.0));+   }+   return sqrt (term);+}++#undef AD_X0+#undef AD_X1+/*=========================================================================*/++double fdist_AndersonDarling (long N, double x)+{+   if (1 == N)+      return AD_N_1 (x);+   util_Assert (N > 0, "fdist_AndersonDarling:   N <= 0");++   if (x <= 0.0)+      return 0.0;+   if (x >= fdist_XBIG)+      return 1.0;++   if (x <= 0.2) {+      /* Sinclair and Spurr lower tail approximation (3.6) */+      double q;+      q = 1.784 + 0.9936*x + 0.03287/x - (2.018 + 0.2029/x)/sqrt (x);+      if (q < -18.0)+         return exp(q);+      q = 1.0 + exp(q);+      return 1.0 - 1.0 / q;+   }+   return 1.0 - fbar_AndersonDarling (N, x);+}+++/*=========================================================================*/+/* The following code is part of Marsaglia's file ADinf.c.+   Very little has been changed to adapt it to ProbDist. The file was +   downloaded from the site of the Journal of Statistical Software+      http://www.jstatsoft.org/v09/i02/+*/++/*--------------------------------------------------------------------------*/+        /* This is file ADinf.c */+/*+A procedure for evaluating the limiting distribution of the+             Anderson-Darling statistic A_n=+-n-(1/n)[ln(x_1(1-x_n)+3ln(x_2(1-x_{n-1})+5ln(x_3(1-x_{n-2})+...+   +(2n-1)ln(x_n(1-x_1))]+    where x_1<x_2<...<x_n is an ordered set of purported uniform +  [0,1) variates.+The function is ADinf(z)=lim_{n->infty} Pr[A_n<z]. About 15 digit accuracy.+If you don't need that much accuracy, use the quick-and-easy adinf(z).+ADinf uses a two-term recursion for coefficients in series for which + initial values+require the complementary normal integral, included as cPhi(z).+Otherwise, use erfc() if your C compiler has one with adequate accuracy.+*/++static double ADf (double z, int j)+{                                 /* called by ADinf(); see article. */+   double t, f, fnew, a, b, c, r;+   int i;+   t = (4 * j + 1) * (4 * j + 1) * 1.23370055013617 / z;+   if (t > 150.)+      return 0.;+   a = 2.22144146907918 * exp (-t) / sqrt (t);+   /* initialization requires cPhi */+   /* if you have erfc(), replace 2*cPhi(sqrt(2*t)) with erfc(sqrt(t)) */+   b = 3.93740248643060 * 2. * fbar_Normal2 (sqrt (2 * t));++   r = z * .125;+   f = a + b * r;+   for (i = 1; i < 200; i++) {+      c = ((i - .5 - t) * b + t * a) / i;+      a = b;+      b = c;+      r *= z / (8 * i + 8);+      if (fabs (r) < 1e-40 || fabs (c) < 1.e-40)+         return f;+      fnew = f + c * r;+      if (f == fnew)+         return f;+      f = fnew;+   }+   return f;+}+++static double ADinf (double z)+{+   int j;+   double ad, adnew, r;+   if (z < .01)+      return 0.;   /* avoids exponent limits; ADinf(.01)=.528e-52 */+   r = 1. / z;+   ad = r * ADf (z, 0);+   for (j = 1; j < 100; j++) {+      r *= (.5 - j) / j;+      adnew = ad + (4 * j + 1) * r * ADf (z, j);+      if (ad == adnew) {+         return ad;+      }+      ad = adnew;+   }+   return ad;++}+++/*------------------------------------------------------------------------*/+/* The following code is part of Marsaglia's file AnDarl.c.+   Very little has been changed to adapt it to ProbDist. The file was +   downloaded from the site of the Journal of Statistical Software+      http://www.jstatsoft.org/v09/i02/+--------------------------------------*/++/*+    Anderson-Darling test for uniformity.   Given an ordered set+              x_1<x_2<...<x_n+ of purported uniform [0,1) variates,  compute+          a = -n-(1/n)*[ln(x_1*z_1)+3*ln(x_2*z_2+...+(2*n-1)*ln(x_n*z_n)]+ where z_1=1-x_n, z_2=1-x_(n-1)...z_n=1-x_1, then find+  v=adinf(a) and return  p=v+errfix(v), which should be uniform in [0,1),+  that is, the p-value associated with the observed x_1<x_2<...<x_n.+*/++/* Short, practical version of full ADinf(z), z>0.   */+static double adinf (double z)+{+   if (z < 2.)+      return exp (-1.2337141 / z) / sqrt (z) * (2.00012 + (.247105 -+            (.0649821 - (.0347962 - (.011672 -+                     .00168691 * z) * z) * z) * z) * z);+   /* max |error| < .000002 for z<2, (p=.90816...) */+   return+      exp (-exp (1.0776 - (2.30695 - (.43424 - (.082433 - (.008056 -+                     .0003146 * z) * z) * z) * z) * z));+   /* max |error|<.0000008 for 4<z<infinity */+}++/*------------------------------------------------------------------------*/+/* The function AD(n,z) returns Prob(A_n<z) where+    A_n = -n-(1/n)*[ln(x_1*z_1)+3*ln(x_2*z_2+...+(2*n-1)*ln(x_n*z_n)]+          z_1=1-x_n, z_2=1-x_(n-1)...z_n=1-x_1, and+    x_1<x_2<...<x_n is an ordered set of iid uniform [0,1) variates.+*/++static double AD (int n, double z, int isFastADinf)+{+   double c, v, x;+   /* If isFastADinf is true, use the fast approximation adinf (z),+      if it is false, use the more exact ADinf (z) */+   if (isFastADinf)+      x = adinf (z);+   else+      x = ADinf (z);++   /* now x=adinf(z). Next, get v=errfix(n,x) and return x+v; */+   if (x > .8) {+      v = (-130.2137 + (745.2337 - (1705.091 - (1950.646 - (1116.360 -+                     255.7844 * x) * x) * x) * x) * x) / n;+      return x + v;+   }+   c = .01265 + .1757 / n;+   if (x < c) {+      v = x / c;+      v = sqrt (v) * (1. - v) * (49 * v - 102);+      return x + v * (.0037 / (n * n) + .00078 / n + .00006) / n;+   }+   v = (x - c) / (.8 - c);+   v = -.00022633 + (6.54034 - (14.6538 - (14.458 - (8.259 -+               1.91864 * v) * v) * v) * v) * v;+   return x + v * (.04213 + .01365 / n) / n;+}++/* You must give the ADtest(int n, double *x) routine a sorted array+       x[0]<=x[1]<=..<=x[n-1]+    that you are testing for uniformity.+   It will return the p-value associated+   with the Anderson-Darling test, using+    the above adinf() and errfix( ,   )+         Not well-suited for n<7,+     (accuracy could drop to 3 digits).+*/+++/*=========================================================================*/+#if 0++double fdist_AndersonDarling2 (long N, double x)+{+   /* This version uses the more exact limiting distribution ADinf */+   if (1 == N)+      return AD_N_1 (x);+   return AD (N, x, 0);+}++#else++double fdist_AndersonDarling2 (long N, double x)+{+   /* This version uses the approximate limiting distribution adinf */+   if (1 == N)+      return AD_N_1 (x);+   return AD ((int)N, x, 1);+}++#endif+/*=========================================================================*/+++/***************************************\+ *+ *      DISCRETE DISTRIBUTIONS+ *+\***************************************/+++++/*=========================================================================*/++double fdist_Geometric (double p, long s)+{+   util_Assert (p >= 0.0 && p <= 1.0, "fdist_Geometric:   p not in [0, 1]");+   if (s < 0)+      return 0.0;+   if (p >= 1.0)                  /* In fact, p == 1 */+      return 1.0;+   if (p <= 0.0)                  /* In fact, p == 0 */+      return 0.0;+   return 1.0 - pow (1.0 - p, (double) (s + 1));+}+++/*=========================================================================*/++double fdist_Poisson1 (double lam, long s)+/*+ * On our machine, computing a value using fdist_Gamma is faster than the + * naive computation for lamlim > 150.0, slower for lamlim < 150.0+ */+{+   const double lamlim = 150.0;+   long i;+   double term, sum;++   util_Assert (lam >= 0.0, "fdist_Poisson1:   lambda < 0");+   if (lam == 0.0)+      return 1.0;+   if (s < 0)+      return 0.0;++   /* If lam > lamlim, we use the Chi2 distribution according to the exact+      relation, with 2s + 2 degrees of freedom fdist_Poisson (lam, s) = 1 -+      fdist_ChiSquare (2s + 2, 2*lam) which also equals 1 - fdist_Gamma (s ++      1, lam) */+   if (lam > lamlim)+      return fbar_Gamma (s + 1.0, 15, lam);++   /* Naive computation: sum all prob. from i = 0 to i = s */+   sum = term = exp (-lam);+   for (i = 1; i <= s; i++) {+      term *= lam / i;+      sum += term;+   }+   return sum;+}+++/*=========================================================================*/++double fdist_Poisson2 (fmass_INFO W, long s)+{+   double lam;+   util_Assert (W != NULL, "fdist_Poisson2:   fmass_INFO is NULL pointer");+   lam = W->paramR[0];++   if (s < 0)+      return 0.0;+   if (lam == 0.0)+      return 1.0;++   /* For large lam, we use the Chi2 distribution according to the exact+      relation, with 2s + 2 degrees of freedom++      fdist_Poisson (lam, s) = 1 - fdist_ChiSquare (2s + 2, 2*lam)++      which equals also 1 - fdist_Gamma (s + 1, lam) */+   if (W->cdf == NULL)+      return fbar_Gamma (s + 1.0, 15, lam);++   if (s >= W->smax)+      return 1.0;++   if (s < W->smin) {+      /* Sum RMAX dominant terms to get a few decimals in the lower tail. One+         could also call fbar_Gamma (s + 1.0, 15, lam) */+      const long RMAX = 20;+      long i;+      double term = fmass_PoissonTerm1 (lam, s);+      double Sum = term;+      i = s;+      while (i > 0 && i >= s - RMAX) {+         term = term * i / lam;+         i--;+         Sum += term;+      }+      return Sum;+   }++   if (s <= W->smed)+      return W->cdf[s - W->smin];+   else+      /* We keep the complementary distribution in the upper part of cdf */+      return 1.0 - W->cdf[s + 1 - W->smin];+}+++/*=========================================================================*/++double fdist_Binomial1 (long n, double p, long s)+{+   const int nlim1 = 10000;+   const double varlim = 100.0;+   double epsilon = fmass_Epsilon;+   double y, z, q = 1.0 - p;+   double sum, term, termmid;+   long i, mid;+   int flag = 0;++   util_Assert (p >= 0.0 && p <= 1.0, "fdist_Binomial1:   p not in [0, 1]");+   util_Assert (n >= 0, "fdist_Binomial1:   n < 0");++   if (0 == n)+      return 1.0;+   if (s < 0)+      return 0.0;+   if (s >= n)+      return 1.0;+   if (p <= 0.0)+      return 1.0;+   if (p >= 1.0)+      return 0.0;                 /* For any s < n */++   if (n < nlim1) {               /* Exact Binomial */+      /* Sum RMAX terms to get a few decimals in the lower tail */+      const long RMAX = 20;+      mid = (long) ((n + 1) * p);+      if (mid > s)+         mid = s;+      sum = term = termmid = fmass_BinomialTerm3 (n, p, mid);++      z = q / p;+      i = mid;+      while (term >= epsilon || i >= mid - RMAX) {+         term *= z * i / (n - i + 1);+         sum += term;+         i--;+         if (i == 0) break;+      }++      z = p / q;+      term = termmid;+      for (i = mid; i < s; i++) {+         term *= z * (n - i) / (i + 1);+         if (term < epsilon)+            break;+         sum += term;+      }+      return sum;++   } else {+      if ((p > 0.5) || ((p == 0.5) && (s > n / 2))) {+         /* use F(p, n, s) = 1 - F(q, n, n-s-1) */+         p = q;+         q = 1.0 - p;+         flag = 1;+         s = n - s - 1;+      }+      if (n * p * q > varlim) {   /* Normal approximation */+         /* Uses the Camp-Paulson approximation based on the F-distribution.+            Its maximum absolute error is smaller than 0.007 / sqrt (npq).+            Ref: W. Molenaar; Approximations to the Poisson, Binomial,....+            QA273.6 M64, p. 93 (1970) */+         term = pow ((s + 1) * q / ((n - s) * p), 1.0 / 3.0);+         y = term * (9 - 1.0 / (s + 1)) - 9 + 1.0 / (n - s);+         z = 3.0 * sqrt (term * term / (s + 1) + 1.0 / (n - s));+         y /= z;+         if (flag) {+            return fbar_Normal1 (y);+         } else {+            return fdist_Normal2 (y);+         }++      } else {                    /* Poisson approximation */+         /* Uses a Bol'shev approximation based on the Poisson distribution.+            Error is O(1/n^4) as n -> infinity. Ref: W. Molenaar;+            Approximations to the Poisson, Binomial,.... QA273.6 M64, p. 107,+            Table 6.2, Formule lambda_9 (1970). */+         y = (2 * n - s) * p / (2.0 - p);+         z = (2.0 * y * y - s * y - (double)s * s - 2 * s) / (6 * (2 * n -+               (double)s) * (2 * n - s));+         z = y / (1 - z);+         if (flag) {+            return fbar_Poisson1 (z, s - 1);+         } else {+            return fdist_Poisson1 (z, s);+         }+      }+   }+}+++/*=========================================================================*/++double fdist_Binomial2 (fmass_INFO W, long s)+{+   double p;+   long n;++   util_Assert (W != NULL, "fdist_Binomial2: fmass_INFO is NULL pointer");+   n = W->paramI[0];+   p = W->paramR[0];+   util_Assert (p >= 0.0 && p <= 1.0, "fdist_Binomial2:   p not in [0, 1]");++   if (0 == n)+      return 1.0;+   if (s < 0)+      return 0.0;+   if (s >= n)+      return 1.0;+   if (p == 0.0)+      return 1.0;+   if (p == 1.0)+      return 0.0;++   if (W->cdf != NULL) {+      if (s >= W->smax)+         return 1.0;+      if (s < W->smin) {+         /* Sum RMAX terms to get a few decimals in the lower tail */+         const long RMAX = 20;+         long i;+         double term = fmass_BinomialTerm3 (n, p, s);+         double Sum = term;+         const double z = (1.0 - p) / p;+         i = s;+         while (i > 0 && i >= s - RMAX) {+            term *= z * i / (n - i + 1);+            i--;+            Sum += term;+         }+         return Sum;+      }+      if (s <= W->smed)+         return W->cdf[s - W->smin];+      else+         /* We keep the complementary distribution in the upper part of cdf */+         return 1.0 - W->cdf[s + 1 - W->smin];++   } else {+      return fdist_Binomial1 (n, p, s);+   }+}+++/*=========================================================================*/++double fdist_NegaBin1 (long n, double p, long s)+{+   const double epsilon = fmass_Epsilon;+   const long lim1 = 100000;+   double sum, term, termmode;+   long i, mode;++   util_Assert (p >= 0.0 && p <= 1.0, "fdist_NegaBin1:   p not in [0, 1]");+   util_Assert (n > 0, "fdist_NegaBin1:   n < 1");++   if (s < 0)+      return 0.0;+   if (p >= 1.0)                  /* In fact, p == 1 */+      return 1.0;+   if (p <= 0.0)                  /* In fact, p == 0 */+      return 0.0;++   /* Compute the maximum term */+   mode = 1 + (long) ((n * (1.0 - p) - 1.0) / p);+   if (mode > s)+      mode = s;++   if (mode <= lim1) {+      sum = term = termmode = fmass_NegaBinTerm1 (n, p, mode);+      for (i = mode; i > 0; i--) {+         term *= i / ((1.0 - p) * (n + i - 1));+         if (term < epsilon)+            break;+         sum += term;+      }++      term = termmode;+      for (i = mode; i < s; i++) {+         term *= (1.0 - p) * (n + i) / (i + 1);+         if (term < epsilon)+            break;+         sum += term;+      }+      if (sum <= 1.0)+         return sum;+      else+         return 1.0;++   } else {+      return 1.0 - fdist_Binomial1 (s + n, p, n - 1);+   }+}+++/*=========================================================================*/++double fdist_NegaBin2 (fmass_INFO W, long s)+{+   double p;+   long n;++   util_Assert (W != NULL, "fdist_NegaBin2: fmass_INFO is NULL pointer");+   n = W->paramI[0];+   p = W->paramR[0];+   util_Assert (p >= 0.0 && p <= 1.0, "fdist_NegaBin2:   p not in [0, 1]");++   if (s < 0)+      return 0.0;+   if (p >= 1.0)                  /* In fact, p == 1 */+      return 1.0;+   if (p <= 0.0)                  /* In fact, p == 0 */+      return 0.0;++   if (W->cdf != NULL) {+      if (s >= W->smax)+         return 1.0;+      if (s < W->smin)+         return fdist_NegaBin1 (n, p, s);+      if (s <= W->smed)+         return W->cdf[s - W->smin];+      else+         /* We keep the complementary distribution in the upper part of cdf */+         return 1.0 - W->cdf[s + 1 - W->smin];++   } else {+      return fdist_NegaBin1 (n, p, s);+   }+}+++/*=========================================================================*/++double fdist_Scan (long N, double d, long m)+{+   return 1.0 - fbar_Scan (N, d, m);+}+++/*=========================================================================*/
+ cbits/testu/src/fmarsa.c view
@@ -0,0 +1,483 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           fmarsa.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/+++#include "util.h"+#include "gofs.h"+#include "num.h"++#include "fmarsa.h"+#include "fcho.h"+#include "ffam.h"+#include "fres.h"+#include "ftab.h"+#include "smarsa.h"+#include "unif01.h"++#include <string.h>+#include <limits.h>+#include <math.h>++long fmarsa_Maxn = 1024 * 1024 * 32;+long fmarsa_MaxL = 1024 * 4;+++++/*------------------------------ Functions --------------------------------*/+++static void InitRes2 (+   ffam_Fam *fam,+   fmarsa_Res2 *res,          /* Results holder */+   int N,                     /* Number of replications */+   int Nr,+   int j1, int j2, int jstep,+   char *name1,+   char *name2+)+/* + * Initializes the fmarsa_Res2 structure+ */+{+   fres_InitCont (fam, res->GCD, N, Nr, j1, j2, jstep, name1);+   fres_InitCont (fam, res->NumIter, N, Nr, j1, j2, jstep, name2);+}+++/*-------------------------------------------------------------------------*/++fmarsa_Res2 * fmarsa_CreateRes2 (void)+{+   fmarsa_Res2 *res;+   res = util_Malloc (sizeof (fmarsa_Res2));+   res->NumIter = fres_CreateCont ();+   res->GCD = fres_CreateCont ();+   return res;+}+++/*-------------------------------------------------------------------------*/++void fmarsa_DeleteRes2 (fmarsa_Res2 *res)+{+   if (res == NULL)+      return;+   fres_DeleteCont (res->GCD);+   fres_DeleteCont (res->NumIter);+   util_Free (res);+}+++/*=========================================================================*/++static void PrintHead (char *test, ffam_Fam * fam,+   long N, long n, int r, int s, int L, int t, int p,+   int Nr, int j1, int j2, int jstep)+{+   printf+   ("\n\n================================================================\n");+   printf ("Family:  %s\n\n", fam->name);+   printf ("Test:    %s\n", test);+   printf ("   N  = %ld,", N);+   if (n)+      printf ("   n = %ld,", n);+   printf ("   r = %d,", r);+   if (s)+      printf ("   s = %d,", s);+   if (L)+      printf ("   L = %d", L);+   if (t)+      printf ("   t = %d,", t);+   if (p)+      printf ("   p = %d", p);+   printf ("\n   Nr = %d,   j1 = %d,   j2 = %d,   jstep = %d\n\n",+      Nr, j1, j2, jstep);+}+++/*=========================================================================*/++static int CheckParamMat (int prec, void *cho,+   long *pn, int *pr, int *ps, long *pL, long LMin, int i, int j)+/*+ * Set the values of the parameters for the test. If a parameter is < 0,+ * will call a choose function to set it. Otherwise, will accept it as is.+ * Returns 0 if parameters are ok for the test, returns -1 if the test+ * should not be done for these parameters.+ */+{+   fcho_Cho2 *cho2 = cho;+   fcho_Cho *chon;+   fcho_Cho *choL;++   util_Assert (cho, "fmarsa:   cho is NULL");+   chon = cho2->Chon;+   choL = cho2->Chop2;+   if (*pn < 0) {+      util_Assert (chon, "fmarsa:   n < 0 and chon is NULL");+      *pn = chon->Choose (chon->param, i, j);++      if (*pn <= 3.0 * gofs_MinExpected) {+         printf ("n is too small\n\n");+         return -1;+      }+      if (*pn > fmarsa_Maxn) {+         printf ("n > %2ld\n\n", fmarsa_Maxn);+         return -1;+      }+   }++   *ps = fcho_Chooses (*pr, *ps, prec);+   if (*ps <= 0)+      return -1;++   if (*pL < 0) {+      util_Assert (choL, "fmarsa:   L < 0 and chop2 is NULL");+      *pL = choL->Choose (choL->param, i, j);++      if (*pL <= LMin) {+         printf ("L is too small\n\n");+         return -1;+      }+      if (*pL > fmarsa_MaxL) {+         printf ("L > %2ld\n\n", fmarsa_MaxL);+         return -1;+      }+   }+   return 0;+}+++/*=========================================================================*/+++static void TabMatrixR (ffam_Fam * fam, void *res1, void *cho,+   void *par1, int i, int j, int irow, int icol)+{+   int r, s;+   long N, n, L;+   const long *Par = par1;+   fres_Cont *fres = res1;+   sres_Chi2 *sres;++   N = Par[0];+   n = Par[1];+   r = Par[2];+   s = Par[3];+   L = Par[4];++   if (CheckParamMat (fam->Resol[irow], cho, &n, &r, &s, &L, 1, i, j))+      return;++   sres = sres_CreateChi2 ();+   smarsa_MatrixRank (fam->Gen[irow], sres, N, n, r, s, L, L);+   fres_FillTableEntryC (fres, sres->pVal2, N, irow, icol);+   sres_DeleteChi2 (sres);+}+++/*-------------------------------------------------------------------------*/++void fmarsa_MatrixR1 (ffam_Fam * fam, fres_Cont * res, fcho_Cho2 * cho,+   long N, long n, int r, int s, int L, int Nr, int j1, int j2, int jstep)+{+   long Par[5] = { 0 };+   lebool localRes;++   Par[0] = N;+   Par[1] = n;+   Par[2] = r;+   Par[3] = s;+   Par[4] = L;+   if (res == NULL) {+      localRes = TRUE;+      res = fres_CreateCont ();+   } else+      localRes = FALSE;++   util_Assert (n < 0 || L < 0, +      "fmarsa_MatrixR1:   Either n or L must be < 0" );+   PrintHead ("fmarsa_MatrixR1", fam, N, n, r, s, L, 0, 0, Nr, j1, j2,+      jstep);+   fres_InitCont (fam, res, N, Nr, j1, j2, jstep, "fmarsa_MatrixR1");+   ftab_MakeTables (fam, res, cho, Par, TabMatrixR, Nr, j1, j2, jstep);+   fres_PrintCont (res);+   if (localRes)+      fres_DeleteCont (res);+}+++/*=========================================================================*/++static void WriteBirthEC (void *vpar, long junk1, long junk2)+{+   double *Par = vpar;+   double EC = Par[2];+   printf ("Choose d such that EC = %f\n\n", EC);+}++/*-------------------------------------------------------------------------*/++static double ChooseBirthEC (void *vpar, long n, long junk)+{+   double *Par = vpar;+   long N = Par[0];+   int t = Par[1];+   double EC = Par[2];+   long d;+   double k, dr;+   double Mu;++   WriteBirthEC (vpar, 0, 0);+   k = (N * (double) n * n * n) / (4.0 * EC);+   if (k >= smarsa_Maxk) {+      printf ("k >= %2.0f\n\n", smarsa_Maxk);+      return -1.0;+   }+   d = dr = pow (k, 1.0 / t);+   if (dr > LONG_MAX) {+      printf ("d > LONG_MAX\n\n");+      return -1.0;+   }++   k = pow ((double) d, (double) t);+   Mu = N * (double) n * n * n / (4.0 * k);+   if (8.0 * Mu > sqrt (sqrt (k))) {+      printf ("8 EC > k^(1/4)\n\n");+      return -1.0;+   }+   return (double) d;+}++/*-------------------------------------------------------------------------*/++fcho_Cho *fmarsa_CreateBirthEC (long N, int t, double EC)+{+   fcho_Cho *cho;+   double *Par;++   cho = util_Malloc (sizeof (fcho_Cho));+   Par = util_Calloc (3, sizeof (double));+   Par[0] = N;+   Par[1] = t;+   Par[2] = EC;+   cho->param = Par;+   cho->Write = WriteBirthEC;+   cho->Choose = ChooseBirthEC;+   cho->name = util_Calloc (2, sizeof (char));+   strcpy (cho->name, "d");+   return cho;+}++/*-------------------------------------------------------------------------*/++void fmarsa_DeleteBirthEC (fcho_Cho * cho)+{+   if (NULL == cho)+      return;+   cho->name = util_Free (cho->name);+   cho->param = util_Free (cho->param);+   util_Free (cho);+}+++/*=========================================================================*/++static int CheckParamBirth (int prec, void *cho,+   long *pn, int *pr, long *pd, int i, int j)+/*+ * Set the values of the parameters for the test.+ * Returns 0 if parameters are ok for the test, returns -1 if the test+ * should not be done for these parameters.+ */+{+   fcho_Cho2 *cho2 = cho;+   fcho_Cho *chon;+   fcho_Cho *chod;+   int s;++   util_Assert (cho, "fmarsa:   cho is NULL");+   chon = cho2->Chon;+   chod = cho2->Chop2;+   util_Assert (chon, "fmarsa:   chon is NULL");+   *pn = chon->Choose (chon->param, i, j);+   if (*pn > fmarsa_Maxn) {+      printf ("n > %2ld\n\n", fmarsa_Maxn);+      return -1;+   }++   util_Assert (chod, "fmarsa:   chop2 is NULL");+   *pd = chod->Choose (chod->param, *pn, 0);+   if (*pd <= 1.0)+      return -1;++   s = num_Log2 ((double) *pd);+   if (*pr + s > prec) {+      printf ("r + Lg(d) > Resolution of generator\n\n");+      return -1;+   }++   return 0;+}+++/*=========================================================================*/++static void TabBirthdayS (ffam_Fam * fam, void *vres, void *cho,+   void *vpar, int i, int j, int irow, int icol)+{+   int r, t, p;+   long N, n, d;+   const long *Par = vpar;+   fres_Poisson *fres = vres;+   sres_Poisson *sres;++   N = Par[0];+   r = Par[1];+   t = Par[2];+   p = Par[3];++   if (CheckParamBirth (fam->Resol[irow], cho, &n, &r, &d, i, j))+      return;++   sres = sres_CreatePoisson ();+   smarsa_BirthdaySpacings (fam->Gen[irow], sres, N, n, r, d, t, p);+   fres_FillTableEntryPoisson (fres, sres->Mu, sres->sVal2, sres->pLeft,+      sres->pRight, sres->pVal2, irow, icol);+   sres_DeletePoisson (sres);+}+++/*-------------------------------------------------------------------------*/++void fmarsa_BirthdayS1 (ffam_Fam * fam, fres_Poisson * res, fcho_Cho2 * cho,+   long N, int r, int t, int p, int Nr, int j1, int j2, int jstep)+{+   long Par[4] = { 0 };+   lebool localRes;++   Par[0] = N;+   Par[1] = r;+   Par[2] = t;+   Par[3] = p;++   if (res == NULL) {+      localRes = TRUE;+      res = fres_CreatePoisson ();+   } else+      localRes = FALSE;++   PrintHead ("fmarsa_BirthdayS1",+      fam, N, 0, r, 0, 0, t, p, Nr, j1, j2, jstep);+   fres_InitPoisson (fam, res, Nr, j1, j2, jstep, "fmarsa_BirthdayS1");+   ftab_MakeTables (fam, res, cho, Par, TabBirthdayS, Nr, j1, j2, jstep);+   ftab_PrintTable2 (res->Exp, res->Obs, FALSE);+   ftab_PrintTable (res->PVal2);+   if (localRes)+      fres_DeletePoisson (res);+}+++/*========================================================================*/++void fmarsa_SerialOver1 (void)+{+   util_Error ("fmarsa_SerialOver1:   use fmultin_SerialOver1 instead");+}++/*========================================================================*/++void fmarsa_CollisionOver1 (void)+{+   util_Error ("fmarsa_CollisionOver1:   use fmultin_SerialOver1 instead");+}+++/*=========================================================================*/++static void TabGCD (ffam_Fam * fam, void *res1, void *cho,+   void *par1, int i, int j, int irow, int icol)+{+   int r, s;+   long N, n;+   const long *Par = par1;+   fmarsa_Res2 *fres = res1;+   smarsa_Res2 *sres;++   N = Par[0];+   r = Par[1];+   s = Par[2];++   n = fcho_ChooseParamL (cho, (long) (3.0 * gofs_MinExpected),+          fmarsa_Maxn, i, j);+   if (n <= 0)+      return;+   s = fcho_Chooses (r, s, fam->Resol[irow]);+   if (s <= 0)+      return;++   sres = smarsa_CreateRes2 ();+   smarsa_GCD (fam->Gen[irow], sres, N, n, r, s);+   fres_FillTableEntryC (fres->GCD, sres->GCD->pVal2, N, irow, icol);+   fres_FillTableEntryC (fres->NumIter, sres->NumIter->pVal2, N, irow, icol);+   smarsa_DeleteRes2 (sres);+}+++/*-------------------------------------------------------------------------*/++void fmarsa_GCD1 (ffam_Fam *fam, fmarsa_Res2 *res, fcho_Cho *cho,+   long N, int r, int s, int Nr, int j1, int j2, int jstep)+{+   long Par[3] = { 0 };+   lebool localRes;++   Par[0] = N;+   Par[1] = r;+   Par[2] = s;+   if (res == NULL) {+      localRes = TRUE;+      res = fmarsa_CreateRes2 ();+   } else+      localRes = FALSE;++   PrintHead ("fmarsa_GCD1", fam, N, 0, r, s, 0, 0, 0, Nr, j1, j2, jstep);+   InitRes2 (fam, res, N, Nr, j1, j2, jstep,+             "fmarsa_GCD1, GCD", "fmarsa_GCD1, NumIter");+   ftab_MakeTables (fam, res, cho, Par, TabGCD, Nr, j1, j2, jstep);+   fres_PrintCont (res->GCD);+   /*   fres_PrintCont (res->NumIter); */+   if (localRes)+      fmarsa_DeleteRes2 (res);+}+++/*=========================================================================*/
+ cbits/testu/src/fmass.c view
@@ -0,0 +1,780 @@+/*************************************************************************\+ *+ * Package:        ProbDist+ * File:           fmass.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/+++#include "fmass.h"++#include "util.h"+#include "num.h"+#include "num2.h"++#include <stddef.h>+#include <float.h>+#include <math.h>+#include <stdlib.h>+++#define TRACE1(N) printf ("*********   " #N " = %d\n", N);+#define TRACE2(x) printf ("*********   " #x " = %g\n", x);+++double fmass_Epsilon = 1.0e-16;++/* When we precompute probability terms until terms are smaller than+   fmass_Epsilon, the last few terms will not be very precise. Instead we+   add terms as small as fmass_Epsilon * EPS_EXTRA to get a few correct digits +   at the tails of the precomputed distributions. */+static const double EPS_EXTRA = 1 / 100.0;++double fmass_MaxLambdaPoisson = 100000.0;++double fmass_MaxnBinomial = 100000.0;++double fmass_MaxnNegaBin = 100000.0;+++++/*=========================================================================*/++double fmass_PoissonTerm1 (double lam, long s)+{+   const double lamlim = 20.0;+   double y;+   double x = s;+   double Res;++   if (s < 0)+      return 0.0;++   if ((lam < lamlim) && (x < 2.0 * lamlim)) {+      Res = exp (-lam) * pow (lam, x) / num2_Factorial (s);++   } else {+      y = x * log (lam) - num2_LnGamma (x + 1.0) - lam;+      Res = exp (y);+   }++   return Res;+}++/*=========================================================================*/++fmass_INFO fmass_CreatePoisson (double lam)+{+   double epsilon;+   long i, mid, Nmax;+   long imin, imax;+   double sum;+   fmass_INFO W;+   double *P;                     /* Poisson probability terms */+   double *F;                     /* Poisson cumulative probabilities */++   util_Assert (lam >= 0.0, "fmass_CreatePoisson:   lambda < 0");+   W = (fmass_INFO) util_Malloc (sizeof (struct fmass_INFO_T));+   W->paramI = NULL;+   W->paramR = (double *) util_Malloc (sizeof (double));+   W->paramR[0] = lam;++   /* For lam > fmass_MaxLambdaPoisson, we do not use pre-computed arrays */+   if (lam > fmass_MaxLambdaPoisson) {+      W->pdf = NULL;+      W->cdf = NULL;+      return W;+   }++   /* In theory, the Poisson distribution has an infinite range. But */+   /* for i > Nmax, probabilities should be extremely small. */+   Nmax = (long) (lam + 16 * (2 + sqrt (lam)));+   P = (double *) util_Calloc ((size_t) (1 + Nmax), sizeof (double));+   F = (double *) util_Calloc ((size_t) (1 + Nmax), sizeof (double));++   mid = (long) lam;+   epsilon = EPS_EXTRA * fmass_Epsilon / fmass_PoissonTerm1 (lam, mid);+   /* For large lam, fmass_PoissonTerm1 will lose a few digits of precision */+   /* We shall normalize by explicitly summing all terms >= epsilon */+   sum = P[mid] = 1.0;++   /* Start from the maximum and compute terms > epsilon on each side. */+   i = mid;+   while (i > 0 && P[i] > epsilon) {+      P[i - 1] = P[i] * i / lam;+      i--;+      sum += P[i];+   }+   W->smin = imin = i;++   i = mid;+   while (P[i] > epsilon) {+      P[i + 1] = P[i] * lam / (i + 1);+      i++;+      sum += P[i];+      if (i >= Nmax - 1) {+         Nmax *= 2;+         P = (double *) util_Realloc (P, (1 + Nmax) * sizeof (double));+         F = (double *) util_Realloc (F, (1 + Nmax) * sizeof (double));+         /* util_Warning (TRUE, "fmass_CreatePoisson: Calling Realloc"); */+      }+   }+   W->smax = imax = i;++   /* Renormalize the sum of probabilities to 1 */+   for (i = imin; i <= imax; i++) {+      P[i] /= sum;+   }++   /* Compute the cumulative probabilities until F >= 0.5, and keep them in+      the lower part of array, i.e. F[s] contains all P[i] for i <= s */+   F[imin] = P[imin];+   i = imin;+   while (i < imax && F[i] < 0.5) {+      i++;+      F[i] = P[i] + F[i - 1];+   }+   /* This is the boundary between F and 1 - F in the CDF */+   W->smed = i;+ +   /* Compute the cumulative probabilities of the complementary distribution+      and keep them in the upper part of the array. i.e. F[s] contains all+      P[i] for i >= s */+   F[imax] = P[imax];+   i = imax - 1;+   while (i > W->smed) {+      F[i] = P[i] + F[i + 1];+      i--;+   };++   /* Reset imin because we lose too much precision for a few terms near+      imin when we stop adding terms < epsilon. */+   i = imin;+   while (i < W->smed && F[i] < fmass_Epsilon)+      i++; +   W->smin = imin = i;++   /* Same thing with imax */+   i = imax;+   while (i > W->smed && F[i] < fmass_Epsilon)+      i--; +   W->smax = imax = i;++   W->pdf = (double *) util_Calloc ((size_t) (imax + 1 - imin), sizeof (double));+   W->cdf = (double *) util_Calloc ((size_t) (imax + 1 - imin), sizeof (double));+   for (i = imin; i <= imax; i++) {+      W->pdf[i - imin] = P[i];+      W->cdf[i - imin] = F[i];+   }+   util_Free (P);+   util_Free (F);+   return W;+}++/*-------------------------------------------------------------------------*/++double fmass_PoissonTerm2 (fmass_INFO W, long s)+{+   double lam;++   util_Assert (W != NULL,+      "fmass_PoissonTerm2:  fmass_INFO is NULL pointer");+   lam = W->paramR[0];+   if (s < 0)+      return 0.0;+   if (W->pdf == NULL)+      return fmass_PoissonTerm1 (lam, s);+   if (s > W->smax || s < W->smin)+      return fmass_PoissonTerm1 (lam, s);+   return W->pdf[s - W->smin];+}++/*-------------------------------------------------------------------------*/++void fmass_DeletePoisson (fmass_INFO W)+{+   if (W == NULL)+      return;+   util_Free (W->paramR);+   util_Free (W->pdf);+   util_Free (W->cdf);+   util_Free (W);+}+++/*=========================================================================*/++double fmass_BinomialTerm1 (long n, double p, double q, long s)+{+   const long slim = 30;          /* To avoid overflow */+   const double maxexp = (DBL_MAX_EXP - 1) * num_Ln2; /* To avoid overflow */+   const double minexp = (DBL_MIN_EXP - 1) * num_Ln2; /* To avoid underflow */+   int signe = 1;+   double Res;++   util_Assert (n >= 0, "fmass_BinomialTerm1:   n < 0");+   if (0 == n)+      return 1.0;+   if (s < 0 || s > n)+      return 0.0;++   /* Combination(n, s) are symmetric between s and n-s */+   if (s > n / 2) {+      s = n - s;+      Res = p;+      p = q;+      q = Res;+   }++   if (p < 0.0) {+      p = -p;+      if (s & 1)+         signe *= -1;             /* odd s */+   }+   if (q < 0.0) {+      q = -q;+      if ((n - s) & 1)+         signe *= -1;             /* odd n - s */+   }++   if (n <= slim) {+      Res = pow (p, (double) s) * num2_Combination (n, s) * pow (q,+         (double) (n - s));+      return signe * Res;++   } else {+      /* This could be calculated with more precision as there is some+         cancellation because of subtraction of the large LnFactorial: the+         last few digits can be lost. But we need the function lgammal in+         long double precision. Another possibility would be to use an+         asymptotic expansion for the binomial coefficient. */+      Res = s * log (p) + (n - s) * log (q) + num2_LnFactorial (n)+         - num2_LnFactorial (n - s) - num2_LnFactorial (s);+      util_Assert (Res < maxexp, "fmass_BinomialTerm1:   term overflow");++      if (Res < minexp)+         return 0.0;++      return signe * exp (Res);+   }+}+++/*=========================================================================*/++double fmass_BinomialTerm4 (long n, double p, double p2, long s)+{+   const long slim = 30;          /* To avoid overflow */+   const double maxexp = (DBL_MAX_EXP - 1) * num_Ln2; /* To avoid overflow */+   const double minexp = (DBL_MIN_EXP - 1) * num_Ln2; /* To avoid underflow */+   double Res;++   util_Assert (p >= 0.0 && p <= 1.0, "fmass_BinomialTerm4:   p not in [0, 1]");+   util_Assert (p2 >= 0.0 && p2 <= 1.0, "fmass_BinomialTerm4:   p2 not in [0, 1]");+   util_Assert (n >= 0, "fmass_BinomialTerm4:   n < 0");+   if (0 == n)+      return 1.0;+   if (s < 0 || s > n)+      return 0.0;++   if (n <= slim) {+      if (p2 > 1.0e-1) {+         Res = pow (p, (double) s) * num2_Combination (n, s) * pow (1.0 - p2,+               (double) (n - s));+      } else {+         double temp = (n - s)*num2_log1p (-p2);+         Res = pow (p, (double) s) * num2_Combination (n, s) * exp(temp);+      }+      return Res;++   } else {+      /* This could be calculated with more precision as there is some+         cancellation because of subtraction of the large LnFactorial: the+         last few digits can be lost. But we need the function lgammal in+         long double precision. Another possibility would be to use an+         asymptotic expansion for the binomial coefficient. */+      Res = s * log (p) + (n - s) * num2_log1p(-p2) + num2_LnFactorial (n)+         - num2_LnFactorial (n - s) - num2_LnFactorial (s);+      util_Assert (Res < maxexp, "fmass_BinomialTerm4:   term overflow");++      if (Res < minexp)+         return 0.0;++      return exp (Res);+   }+}+++/*=========================================================================*/++double fmass_BinomialTerm3 (long n, double p, long s)+{+   const long slim = 50;          /* To avoid overflow */+   const double maxexp = (DBL_MAX_EXP - 1) * num_Ln2; /* To avoid overflow */+   const double minexp = (DBL_MIN_EXP - 1) * num_Ln2; /* To avoid underflow */+   int signe = 1;+   double Res;+   double q = 1.0 - p;++   /* util_Assert (p >= 0.0 && p <= 1.0, "fmass_BinomialTerm3: p not in [0,+      1]"); */+   util_Assert (n >= 0, "fmass_BinomialTerm3:   n < 0");+   if (0 == n)+      return 1.0;+   if (s < 0 || s > n)+      return 0.0;++   /* Combination(n, s) are symmetric between s and n-s */+   if (s > n / 2) {+      s = n - s;+      Res = p;+      p = q;+      q = Res;+   }++   if (p < 0.0) {+      p = -p;+      if (s & 1)+         signe *= -1;             /* odd s */+   }+   if (q < 0.0) {+      q = -q;+      if ((n - s) & 1)+         signe *= -1;             /* odd n - s */+   }++   if (n <= slim) {+      if (p > 1.0e-1) {+         Res = pow (p, (double) s) * num2_Combination (n, s) * pow (q,+               (double) (n - s));+      } else {+         double temp = (n - s)*num2_log1p (-p);+         Res = pow (p, (double) s) * num2_Combination (n, s) * exp(temp);+      }+      return signe * Res;++   } else {+      /* This could be calculated with more precision as there is some+         cancellation because of subtraction of the large LnFactorial: the+         last few digits can be lost. But we need the function lgammal in+         long double precision. Another possibility would be to use an+         asymptotic expansion for the binomial coefficient. */+      Res = s * log (p) + (n - s) * num2_log1p (-p) + num2_LnFactorial (n)+         - num2_LnFactorial (n - s) - num2_LnFactorial (s);+      util_Assert (Res < maxexp, "fmass_BinomialTerm3:   term overflow");++      if (Res < minexp)+         return 0.0;++      return signe * exp (Res);+   }+}+++/*=========================================================================*/++fmass_INFO fmass_CreateBinomial (long n, double p, double q)+{+/* + * Compute all probability terms of the binomial distribution; start near+ * the mean, and calculate probabilities on each side until they become+ * smaller than epsilon, then stop there.+ * However, this is more general than the binomial probability distribu-+ * tion as this will compute the binomial terms when p + q != 1, and+ * even when p or q are negative. However in this case, the cumulative+ * terms are meaningless and are not computed.+ */+   const double epsilon = fmass_Epsilon * EPS_EXTRA;+   long i, mid;+   long imin, imax;+   double z = 0;+   fmass_INFO W;+   double *P;                     /* Binomial "probability" terms */+   double *F;                     /* Binomial cumulative "probabilities" */++   util_Assert (n > 0, "fmass_CreateBinomial:  n <= 0");++   W = (fmass_INFO) util_Malloc (sizeof (struct fmass_INFO_T));+   W->paramI = (long *) util_Malloc (sizeof (long));+   W->paramR = (double *) util_Calloc ((size_t) 2, sizeof (double));+   W->paramI[0] = n;+   W->paramR[0] = p;+   W->paramR[1] = q;++   /* For n > fmass_MaxnBinomial, we shall not use pre-computed arrays */+   if (n > fmass_MaxnBinomial) {+      W->pdf = NULL;+      W->cdf = NULL;+      return W;+   }++   P = (double *) util_Calloc ((size_t) (1 + n), sizeof (double));+   F = (double *) util_Calloc ((size_t) (1 + n), sizeof (double));++   /* the maximum term in absolute value */+   mid = (long) ((n + 1) * fabs (p) / (fabs (p) + fabs (q)));+   if (mid > n)+      mid = n;+   P[mid] = fmass_BinomialTerm1 (n, p, q, mid);++   if (fabs(p) > 0.0) {+      z = q / p;+   } else {+      z = 0.0;+      util_Warning (1, "fmass_CreateBinomial:   q / p = infinite");+   }+   i = mid;+   while (i > 0 && fabs (P[i]) > epsilon) {+      P[i - 1] = P[i] * z * i / (n - i + 1);+      i--;+   }+   imin = i;++   if (fabs(q) > 0.0) {+      z = p / q;+   } else {+      z = 0.0;+      util_Warning (1, "fmass_CreateBinomial:   p / q = infinite");+   }+   i = mid;+   while (i < n && fabs (P[i]) > epsilon) {+      P[i + 1] = P[i] * z * (n - i) / (i + 1);+      i++;+   }+   imax = i;++   /* Here, we assume that we are dealing with a probability distribution. */+   /* Compute the cumulative probabilities for F and keep them in the */+   /* lower part of CDF. */+   F[imin] = P[imin];+   i = imin;+   while (i < n && F[i] < 0.5) {+      i++;+      F[i] = F[i - 1] + P[i];+   }++   /* This is the boundary between F (i <= smed) and 1 - F (i > smed) in */+   /* the array CDF */+   W->smed = i;++   /* Compute the cumulative probabilities of the complementary */+   /* distribution and keep them in the upper part of the array */+   F[imax] = P[imax];+   i = imax - 1;+   while (i > W->smed) {+      F[i] = P[i] + F[i + 1];+      i--;+   }++   /* Reset imin because we lose too much precision for a few terms near+      imin when we stop adding terms < epsilon. */+   i = imin;+   while (i < W->smed && F[i] < fmass_Epsilon)+      i++; +   W->smin = imin = i;++   /* Same thing with imax */+   i = imax;+   while (i > W->smed && F[i] < fmass_Epsilon)+      i--; +   W->smax = imax = i;++   W->pdf = (double *) util_Calloc ((size_t) (imax + 1 - imin), sizeof (double));+   W->cdf = (double *) util_Calloc ((size_t) (imax + 1 - imin), sizeof (double));+   for (i = imin; i <= imax; i++) {+      W->pdf[i - imin] = P[i];+      W->cdf[i - imin] = F[i];+   }+   util_Free (P);+   util_Free (F);++   return W;+}++/*-------------------------------------------------------------------------*/++double fmass_BinomialTerm2 (fmass_INFO W, long s)+{+   long n;+   double p, q;++   util_Assert (W != NULL,+      "fmass_BinomialTerm2: fmass_INFO is NULL pointer");+   n = W->paramI[0];+   if (0 == n)+      return 1.0;+   if (s < 0 || s > n)+      return 0.0;+   p = W->paramR[0];+   if (p == 0.0) {+      if (s > 0)+         return 0.0;+      else+         return 1.0;+   }+   q = W->paramR[1];+   if (q == 0.0) {+      if (s < n)+         return 0.0;+      else+         return 1.0;+   }+   if (W->pdf == NULL)+      return fmass_BinomialTerm1 (n, p, q, s);++   if (s > W->smax || s < W->smin)+      return fmass_BinomialTerm1 (n, p, q, s);++   return W->pdf[s - W->smin];+}++/*-------------------------------------------------------------------------*/++void fmass_DeleteBinomial (fmass_INFO W)+{+   if (W == NULL)+      return;+   util_Free (W->paramI);+   util_Free (W->paramR);+   util_Free (W->pdf);+   util_Free (W->cdf);+   util_Free (W);+}+++/*=========================================================================*/++double fmass_NegaBinTerm1 (long n, double p, long s)+{+   const long slim = 15;          /* To avoid overflow */+   const double maxexp = (DBL_MAX_EXP - 1) * num_Ln2; /* To avoid overflow */+   const double minexp = (DBL_MIN_EXP - 1) * num_Ln2; /* To avoid underflow */+   double y;++   util_Assert (p >= 0.0 && p <= 1.0,+      "fmass_NegaBinTerm1:   p not in [0, 1]");+   util_Assert (n > 0, "fmass_NegaBinTerm1:   n < 1");+   if (s < 0)+      return 0.0;+   if (p >= 1.0) {                /* In fact, p == 1 */+      if (0 == s)+         return 1.0;+      else+         return 0.0;+   }+   if (p <= 0.0)                  /* In fact, p == 0 */+      return 0.0;++   if (s <= slim || n <= slim) {+      y = pow (p, (double) n) * num2_Combination (n + s - 1, s) *+         pow (1.0 - p, (double) s);+      return y;++   } else {+      y = s * num2_log1p (-p) + n * log (p) + num2_LnFactorial (n + s - 1)+         - num2_LnFactorial (n - 1) - num2_LnFactorial (s);+      util_Assert (y < maxexp, "fmass_NegaBinTerm1:   term overflow");+      if (y <= minexp)+         return 0.0;+      else+         return exp (y);+   }+}+++/*=========================================================================*/++fmass_INFO fmass_CreateNegaBin (long n, double p)+/* + * Compute all probability terms of the negative binomial distribution;+ * start at the mode, and calculate probabilities on each side until they+ * become smaller than epsilon. Set all others to 0.+ */+{+   double epsilon;+   long i, mode, Nmax;+   long imin, imax;+   double sum;+   fmass_INFO W;+   double *P;                     /* Negative Binomial mass probabilities */+   double *F;                     /* Negative Binomial cumulative+                                     probabilities */++   util_Assert (p >= 0.0 && p <= 1.0,+      "fmass_CreateNegaBin:   p not in [0, 1]");+   util_Assert (n > 0, "fmass_CreateNegaBin:  n < 1");++   W = (fmass_INFO) util_Malloc (sizeof (struct fmass_INFO_T));+   W->paramI = (long *) util_Malloc (sizeof (long));+   W->paramR = (double *) util_Malloc (sizeof (double));+   W->paramI[0] = n;+   W->paramR[0] = p;++   /* Compute the mode (at the maximum term) */+   mode = (long) (1 + (n * (1.0 - p) - 1.0) / p);++   /* For mode > fmass_MaxnNegaBin, we shall not use pre-computed arrays.+      mode < 0 should be impossible, unless overflow of long occur, in+      which case mode will be = LONG_MIN. */+   if (mode < 0 || mode > fmass_MaxnNegaBin) {+      W->pdf = NULL;+      W->cdf = NULL;+      return W;+   }++   /* In theory, the negative binomial distribution has an infinite range. */+   /* But for i > Nmax, probabilities should be extremely small. */+   /* Nmax = Mean + 16 * Standard deviation. */+   Nmax = (long) (n * (1.0 - p) / p + 16 * sqrt (n * (1.0 - p) / (p * p)));+   if (Nmax < 32)+      Nmax = 32;+   P = (double *) util_Calloc ((size_t) (1 + Nmax), sizeof (double));+   F = (double *) util_Calloc ((size_t) (1 + Nmax), sizeof (double));++   epsilon = fmass_Epsilon * EPS_EXTRA / fmass_NegaBinTerm1 (n, p, mode);++   /* We shall normalize by explicitly summing all terms >= epsilon */+   sum = P[mode] = 1.0;++   /* Start from the maximum and compute terms > epsilon on each side. */+   i = mode;+   while (i > 0 && P[i] >= epsilon) {+      P[i - 1] = P[i] * i / ((1.0 - p) * (n + i - 1));+      i--;+      sum += P[i];+   }+   imin = i;++   i = mode;+   while (P[i] >= epsilon) {+      P[i + 1] = P[i] * (1.0 - p) * (n + i) / (i + 1);+      i++;+      sum += P[i];+      if (i == Nmax - 1) {+         Nmax *= 2;+         P = (double *) util_Realloc (P, (1 + Nmax) * sizeof (double));+         F = (double *) util_Realloc (F, (1 + Nmax) * sizeof (double));+         /* util_Warning (TRUE, "fmass_CreateNegaBin: Calling Realloc"); */+      }+   }+   imax = i;++   /* Renormalize the sum of probabilities to 1 */+   for (i = imin; i <= imax; i++) {+      P[i] /= sum;+   }++   /* Compute the cumulative probabilities for F and keep them in the */+   /* lower part of CDF. */+   F[imin] = P[imin];+   i = imin;+   while (i < imax && F[i] < 0.5) {+      i++;+      F[i] = F[i - 1] + P[i];+   }++   /* This is the boundary between F (i <= smed) and 1 - F (i > smed) in */+   /* the array CDF */+   W->smed = i;++   /* Compute the cumulative probabilities of the complementary */+   /* distribution 1 - F and keep them in the upper part of the array */+   F[imax] = P[imax];+   i = imax - 1;+   while (i > W->smed) {+      F[i] = P[i] + F[i + 1];+      i--;+   }++   /* Reset imin because we lose too much precision for a few terms near+      imin when we stop adding terms < epsilon. */+   i = imin;+   while (i < W->smed && F[i] < fmass_Epsilon)+      i++; +   W->smin = imin = i;++   /* Same thing with imax */+   i = imax;+   while (i > W->smed && F[i] < fmass_Epsilon)+      i--; +   W->smax = imax = i;++   W->pdf = (double *) util_Calloc ((size_t) (imax + 1 - imin), sizeof (double));+   W->cdf = (double *) util_Calloc ((size_t) (imax + 1 - imin), sizeof (double));+   for (i = imin; i <= imax; i++) {+      W->pdf[i - imin] = P[i];+      W->cdf[i - imin] = F[i];+   }+   util_Free (P);+   util_Free (F);++   return W;+}++/*-------------------------------------------------------------------------*/++double fmass_NegaBinTerm2 (fmass_INFO W, long s)+{+   double p;+   long n;++   util_Assert (W != NULL,+      "fmass_NegaBinTerm2:  fmass_INFO is NULL pointer");+   if (s < 0)+      return 0.0;+   n = W->paramI[0];+   p = W->paramR[0];+   if (p == 0.0)+      return 0.0;+   if (p == 1.0) {+      if (s > 0)+         return 0.0;+      else+         return 1.0;+   }++   if (W->pdf == NULL)+      return fmass_NegaBinTerm1 (n, p, s);++   if (s > W->smax || s < W->smin)+      return fmass_NegaBinTerm1 (n, p, s);++   return W->pdf[s - W->smin];+}++/*-------------------------------------------------------------------------*/++void fmass_DeleteNegaBin (fmass_INFO W)+{+   if (W == NULL)+      return;+   util_Free (W->paramI);+   util_Free (W->paramR);+   util_Free (W->pdf);+   util_Free (W->cdf);+   util_Free (W);+}
+ cbits/testu/src/fres.c view
@@ -0,0 +1,386 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           fres.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "bitset.h"+#include "fres.h"+#include "ftab.h"++#include <string.h>++#define LEN 100+++++/*=========================================================================*/++void fres_InitCont (ffam_Fam *fam, fres_Cont *res, int N,+   int Nr, int f1, int f2, int fstep, char *nam)+{+   int i, j;+   char str[LEN + 1] = {0};+   size_t len1;+   char *p;++   res->name = util_Realloc (res->name, 1 + strlen (nam) * sizeof (char));+   strcpy (res->name, nam);+   Nr = util_Min (Nr, fam->Ng);+   res->Active = 0;++   for (j = 0; j < gofw_NTestTypes; j++) {+      if ((gofw_Mean == j) ||+            (N > 1 && (bitset_TestBit (gofw_ActiveTests, j)))) {+         strncpy (str, nam, (size_t) LEN);+         len1 = strlen (str);+	 strncat (str, ": ", 3);+         p = strstr (res->PVal[j]->Desc, "p-value");+         if (p)+	    strncat (str, p, (size_t) LEN - len1);+         ftab_DeleteTable (res->PVal[j]);+	 res->PVal[j] = ftab_CreateTable (Nr, f1, f2, fstep, str,+                        ftab_pVal2, 0);+	 ftab_InitMatrix (res->PVal[j], -1.0);+         bitset_SetBit (res->Active, j);+         for (i = 0; i < Nr; i++)+	    res->PVal[j]->LSize[i] = fam->LSize[i];+      }+   }+   if (N > 1)+      bitset_ClearBit (res->Active, gofw_Mean);   +}+++/*-------------------------------------------------------------------------*/++fres_Cont * fres_CreateCont (void)+{+   fres_Cont *res;+   char str[LEN + 1];+   gofw_TestType j;+   size_t m;++   res = util_Malloc (sizeof (fres_Cont));+   res->name = util_Calloc (1, sizeof (char));++   m = strlen ("p-value for statistic ");+   for (j = 0; j < gofw_NTestTypes; j++) {+      if ((gofw_Mean == j) || (bitset_TestBit (gofw_ActiveTests, j))) {+	 strncpy (str, "p-value for ", (size_t) LEN);+	 if (gofw_Mean != j)+            strncat (str, gofw_TestNames[j], (size_t) LEN - m);+	 strncat (str, " statistic", (size_t) LEN - m);+	 res->PVal[j] = ftab_CreateTable (1, 0, 1, 1, str, ftab_pVal2, 0);+      }+   }+   return res;+}+++/*-------------------------------------------------------------------------*/++void fres_DeleteCont (fres_Cont *res)+{+   gofw_TestType j;++   if (res == NULL)+      return;+   res->name = util_Free (res->name);++   for (j = 0; j < gofw_NTestTypes; j++) {+      if ((gofw_Mean == j) || (bitset_TestBit (gofw_ActiveTests, j))) {+         ftab_DeleteTable (res->PVal[j]);+         res->PVal[j] = NULL;+      }+   }+   util_Free (res);+}+++/*=========================================================================*/++void fres_PrintCont (fres_Cont *res)+{+   gofw_TestType j;++   for (j = 0; j <= gofw_Mean; j++) {+      if (bitset_TestBit (res->Active, j))+         ftab_PrintTable (res->PVal[j]);+   }+}+++/*=========================================================================*/++void fres_FillTableEntryC (fres_Cont *fres, gofw_TestArray pval,+   int N, int i, int j)+/*+ * Writes the results of one test in the tables.+ */+{+   gofw_TestType k;++   if (N == 1) {+      fres->PVal[gofw_Mean]->Mat[i][j] = pval[gofw_Mean];++   } else {+      for (k = 0; k <= gofw_Mean; k++) {+         if (bitset_TestBit (gofw_ActiveTests, k)) {+            fres->PVal[k]->Mat[i][j] = pval[k];+         }+      }+   }+}+++/*=========================================================================*/++void fres_InitDisc (ffam_Fam *fam, fres_Disc *res,+   int Nr, int f1, int f2, int fstep, char *nam)+{+   char str[LEN + 1] = {0};+   char str2[LEN + 1] = {0};+   size_t len1;+   int i;++   res->name = util_Realloc (res->name, 1 + strlen (nam) * sizeof (char));+   strcpy (res->name, nam);+   strncpy (str, nam, (size_t) LEN);+   len1 = strlen (nam);+ +   Nr = util_Min (Nr, fam->Ng);++   ftab_DeleteTable (res->PVal2);+   ftab_DeleteTable (res->PRight);+   ftab_DeleteTable (res->PLeft);++   strncpy (str2, nam, (size_t) LEN);+   strncat (str2, ", Left p-value", (size_t) LEN - len1);+   res->PLeft = ftab_CreateTable (Nr, f1, f2, fstep, str2, ftab_pVal1, 0);++   strncpy (str2, nam, (size_t) LEN);+   strncat (str2, ", Right p-value", (size_t) LEN - len1);+   res->PRight = ftab_CreateTable (Nr, f1, f2, fstep, str2, ftab_pVal1, 0);++   strncpy (str2, nam, (size_t) LEN);+   strncat (str2, ", p-value for discrete statistic", (size_t) LEN - len1);+   res->PVal2 = ftab_CreateTable (Nr, f1, f2, fstep, str2, ftab_pVal2, 0);++   ftab_InitMatrix (res->PLeft, -1.0);+   ftab_InitMatrix (res->PRight, -1.0);+   ftab_InitMatrix (res->PVal2, -1.0);++   for (i = 0; i < Nr; i++) {+      res->PLeft->LSize[i] = fam->LSize[i];+      res->PRight->LSize[i] = fam->LSize[i];+      res->PVal2->LSize[i] = fam->LSize[i];+   }+}+++/*-------------------------------------------------------------------------*/++fres_Disc * fres_CreateDisc (void)+{+   fres_Disc *res;++   res = util_Malloc (sizeof (fres_Disc));+   res->name = util_Calloc (1, sizeof (char));++   res->PLeft = ftab_CreateTable (1, 0, 1, 1, "", ftab_pVal1, 0);+   res->PRight = ftab_CreateTable (1, 0, 1, 1, "", ftab_pVal1, 0);+   res->PVal2 = ftab_CreateTable (1, 0, 1, 1, "", ftab_pVal2, 0);+   return res;+}+++/*-------------------------------------------------------------------------*/++void fres_DeleteDisc (fres_Disc *res)+{+   if (res == NULL)+      return;+   res->name = util_Free (res->name);+   ftab_DeleteTable (res->PVal2);+   ftab_DeleteTable (res->PRight);+   ftab_DeleteTable (res->PLeft);+   util_Free (res);+}+++/*=========================================================================*/++void fres_PrintDisc (fres_Disc *res, lebool LR)+{+   if (LR) {+      ftab_PrintTable (res->PLeft);+      ftab_PrintTable (res->PRight);+   }+   ftab_PrintTable (res->PVal2);+}+++/*=========================================================================*/++void fres_FillTableEntryD (fres_Disc *fres,+   double pLeft, double pRight, double pVal2, int i, int j)+/*+ * Writes the results of one test in the tables.+ */+{+   fres->PLeft->Mat[i][j] = pLeft;+   fres->PRight->Mat[i][j] = pRight;+   fres->PVal2->Mat[i][j] = pVal2;+}+++/*=========================================================================*/++void fres_InitPoisson (ffam_Fam *fam, fres_Poisson *res,+   int Nr, int f1, int f2, int fstep, char *nam)+{+   char str[LEN + 1] = {0};+   char str2[LEN + 1] = {0};+   size_t len1;+   int i;++   res->name = util_Realloc (res->name, 1 + strlen (nam) * sizeof (char));+   strcpy (res->name, nam);+   strncpy (str, nam, (size_t) LEN);+   len1 = strlen (nam);+ +   Nr = util_Min (Nr, fam->Ng);++   ftab_DeleteTable (res->Obs);+   ftab_DeleteTable (res->Exp);+   ftab_DeleteTable (res->PVal2);+   ftab_DeleteTable (res->PRight);+   ftab_DeleteTable (res->PLeft);++   strncpy (str2, nam, (size_t) LEN);+   strncat (str2, ", Expected numbers", (size_t) LEN - len1);+   res->Exp = ftab_CreateTable (Nr, f1, f2, fstep, str2, ftab_Real, 0);++   strncpy (str2, nam, (size_t) LEN);+   strncat (str2, ", Observed numbers", (size_t) LEN - len1);+   res->Obs = ftab_CreateTable (Nr, f1, f2, fstep, str2, ftab_Integer, 0);++   strncpy (str2, nam, (size_t) LEN);+   strncat (str2, ", Left p-value", (size_t) LEN - len1);+   res->PLeft = ftab_CreateTable (Nr, f1, f2, fstep, str2, ftab_pVal1, 0);++   strncpy (str2, nam, (size_t) LEN);+   strncat (str2, ", Right p-value", (size_t) LEN - len1);+   res->PRight = ftab_CreateTable (Nr, f1, f2, fstep, str2, ftab_pVal1, 0);++   strncpy (str2, nam, (size_t) LEN);+   strncat (str2, ", p-value for discrete statistic", (size_t) LEN - len1);+   res->PVal2 = ftab_CreateTable (Nr, f1, f2, fstep, str2, ftab_pVal2, 0);++   ftab_InitMatrix (res->Exp, -1.0);+   ftab_InitMatrix (res->Obs, -1.0);+   ftab_InitMatrix (res->PLeft, -1.0);+   ftab_InitMatrix (res->PRight, -1.0);+   ftab_InitMatrix (res->PVal2, -1.0);++   for (i = 0; i < Nr; i++) {+      res->PLeft->LSize[i] = fam->LSize[i];+      res->PRight->LSize[i] = fam->LSize[i];+      res->PVal2->LSize[i] = fam->LSize[i];+      res->Exp->LSize[i] = fam->LSize[i];+      res->Obs->LSize[i] = fam->LSize[i];+   }+}+++/*-------------------------------------------------------------------------*/++fres_Poisson * fres_CreatePoisson (void)+{+   fres_Poisson *res;++   res = util_Malloc (sizeof (fres_Poisson));+   res->name = util_Calloc (1, sizeof (char));++   res->Obs = ftab_CreateTable (1, 0, 1, 1, "", ftab_pVal1, 0);+   res->Exp = ftab_CreateTable (1, 0, 1, 1, "", ftab_pVal1, 0);+   res->PLeft = ftab_CreateTable (1, 0, 1, 1, "", ftab_pVal1, 0);+   res->PRight = ftab_CreateTable (1, 0, 1, 1, "", ftab_pVal1, 0);+   res->PVal2 = ftab_CreateTable (1, 0, 1, 1, "", ftab_pVal2, 0);+   return res;+}+++/*-------------------------------------------------------------------------*/++void fres_DeletePoisson (fres_Poisson *res)+{+   if (res == NULL)+      return;+   res->name = util_Free (res->name);+   ftab_DeleteTable (res->PVal2);+   ftab_DeleteTable (res->PRight);+   ftab_DeleteTable (res->PLeft);+   ftab_DeleteTable (res->Obs);+   ftab_DeleteTable (res->Exp);+   util_Free (res);+}+++/*=========================================================================*/++void fres_PrintPoisson (fres_Poisson *res, lebool LR, lebool Ratio)+{+   ftab_PrintTable2 (res->Exp, res->Obs, Ratio);+   if (LR) {+      ftab_PrintTable (res->PLeft);+      ftab_PrintTable (res->PRight);+   }+   ftab_PrintTable (res->PVal2);+}+++/*=========================================================================*/++void fres_FillTableEntryPoisson (fres_Poisson *fres, double Exp, double Obs,+   double pLeft, double pRight, double pVal2, int i, int j)+/*+ * Writes the results of one test in the tables.+ */+{+   fres->Obs->Mat[i][j] = Obs;+   fres->Exp->Mat[i][j] = Exp;+   fres->PLeft->Mat[i][j] = pLeft;+   fres->PRight->Mat[i][j] = pRight;+   fres->PVal2->Mat[i][j] = pVal2;+}+++/*=========================================================================*/
+ cbits/testu/src/ftab.c view
@@ -0,0 +1,625 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           ftab.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/+++#include "util.h"+#include "chrono.h"+#include "num.h"+#include "tables.h"+#include "gofw.h"++#include "ftab.h"+#include "ffam.h"+#include "swrite.h"++#include <stdio.h>+#include <math.h>+#include <string.h>+#include <limits.h>+++#define MAXLEN 100                /* Max number of chars in Desc[] */++++/*---------------------------- extern variables ---------------------------*/++ftab_StyleType ftab_Style = ftab_Plain;++double ftab_Suspectp = 0.01;++int ftab_SuspectLog2p = 6;+++++/*---------------------------- module variables ---------------------------*/++static double SuspectLog2pval;++++++/*-------------------------------- Functions ------------------------------*/+++void ftab_SetDesc (ftab_Table *T, char *Desc)+{+   size_t len;+   util_Assert (T != NULL, "ftab_SetDesc:  ftab_Table is a NULL pointer");+   len = strlen (Desc);+   if (len > MAXLEN) {+      len = MAXLEN;+      util_Warning (1, "ftab_Table->Desc truncated");+   }+   if (T->Desc != NULL)+      T->Desc = util_Free (T->Desc);+   T->Desc = util_Calloc (len + 1, sizeof (char));+   strncpy (T->Desc, Desc, (size_t) len);+   T->Desc[len] = '\0';+}+++/*=========================================================================*/++ftab_Table *ftab_CreateTable (int Nr, int j1, int j2, int jstep,+   char *Desc, ftab_FormType Form, int Ns)+{+   ftab_Table *T;+   T = util_Malloc (sizeof (ftab_Table));+   memset (T, 0, sizeof (ftab_Table));+   T->Nr = Nr;+   T->j1 = j1;+   T->j2 = j2;+   T->jstep = jstep;+   T->Nc = 1 + (j2 - j1)/jstep;+   T->Mat = tables_CreateMatrixD (T->Nr, T->Nc);+   T->LSize = util_Calloc ((size_t) T->Nr, sizeof (int));+   T->Desc = NULL;+   ftab_SetDesc (T, Desc);+   T->Form = Form;+   if (Form == ftab_String) {+      T->Strings = util_Calloc ((size_t) Ns, sizeof (char *));+      T->Ns = Ns;+   } else+      T->Strings = NULL;+   return T;+}+++/*=========================================================================*/++void ftab_DeleteTable (ftab_Table * T)+{+   if (T == NULL)+      return;+   tables_DeleteMatrixD (&T->Mat);+   T->LSize = util_Free (T->LSize);+   T->Desc = util_Free (T->Desc);+   if (T->Form == ftab_String)+      T->Strings = util_Free (T->Strings);+   util_Free (T);+}+++/*=========================================================================*/++void ftab_InitMatrix (ftab_Table * T, double x)+{+   int i, j;++   for (i = 0; i < T->Nr; i++)+      for (j = 0; j < T->Nc; j++)+         T->Mat[i][j] = x;+}+++/*=========================================================================*/++void ftab_MakeTables (ffam_Fam *fam, void *res, void *cho, void *par,+   ftab_CalcType Calc, int Nr, int f1, int f2, int fstep)+{+   int i, j;   /* Row and column of matrices for results of one test */+   int f;+   chrono_Chrono *Timer;+   unif01_Gen *gen;++   SuspectLog2pval = 1.0 / (num_TwoExp[ftab_SuspectLog2p] - 1.0);++   Timer = chrono_Create ();++   Nr = util_Min (Nr, fam->Ng);+   for (i = 0; i < Nr; i++) {+      if (swrite_Basic) {+         printf ("CPU cumulative time: ");+         chrono_Write (Timer, chrono_hms);+         printf ("\n\n============================================="+                 "==============\n\nLSize = i = %2d\n\n", fam->LSize[i]);+      }+      if ((gen = fam->Gen[i])) {+         f = f1;+         j = 0;+         while (f <= f2) {+            Calc (fam, res, cho, par, fam->LSize[i], f, i, j);+            f += fstep;+            j++;+         }+      }+   }+   if (swrite_Basic) {+      printf ("Total CPU time: ");+      chrono_Write (Timer, chrono_hms);+      printf+         ("\n\n======================================================\n");+   }+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void PrintTexName (char *nam)+/*+ * Make sure that any _ char in Latex format name is printed as \_+ */+{+   char *p, *name = nam;+   size_t len;++   if (NULL == nam)+      return;+   len = strlen (name) + 1;+   name = util_Calloc (len, sizeof (char));+   strncpy (name, nam, (size_t) len);++   while ((p = strchr(name, '_'))) {+      *p = '\0';+      printf ("%s", name);+      printf ("\\_");+      name = p + 1;+   }+   printf ("%s", name);+}+++/*=========================================================================*/++static void PrintLog2 (double d)+/*+ * Prints the logarithm (rounded) of d in base 2, when d is outside the+ * interval [SuspectLog2pval, 1 - SuspectLog2pval]; otherwise prints + * nothing.+ */+{+   int s;++   if (d <= gofw_Epsilonp) {+      printf ("    inf    ");+   } else if (d <= SuspectLog2pval) {+      s = 0.5 - num_Log2 (d);+      printf ("     %2d    ", s);+   } else if (d >= 1.0 - gofw_Epsilonp1) {+      printf ("   -inf    ");+   } else if (d >= 1.0 - SuspectLog2pval) {+      s = 0.5 - num_Log2 (1.0 - d);+      if (s > 9)+         printf ("    ");+      else+         printf ("     ");+      printf ("-%1d    ", s);+   } else+      printf ("           ");+}+++/*-------------------------------------------------------------------------*/++static void PrintLog2Tex (double d)+/*+ * Similar to PrintLog2, but prints in Latex style.+ */+{+   int s;+   if (d <= gofw_Epsilonp) {+      printf (" & $\\infty$  ");+   } else if (d <= SuspectLog2pval) {+      s = 0.5 - num_Log2 (d);+      printf (" &  %3d   ", s);+   } else if (d >= 1.0 - gofw_Epsilonp1) {+      printf (" & $-\\infty$ ");+   } else if (d >= 1.0 - SuspectLog2pval) {+      s = 0.5 - num_Log2 (1.0 - d);+      if (s > 9)+         printf (" &  $-");+      else+         printf (" &   $-");+      printf ("%1d $ ", s);+   } else+      printf (" &        ");+}+++/*=========================================================================*/++static void PrintLog10 (double d)+/*+ * Prints the logarithm (rounded) of d in base 10, when d is outside the+ * interval [ftab_Suspectp, 1 - ftab_Suspectp]; otherwise prints + * nothing.+ */+{+   int s;+   if (d <= gofw_Epsilonp) {+      printf ("    inf   ");+   } else if (d <= ftab_Suspectp) {+      s = 0.5 - log10 (d);+      printf ("     %2d    ", s);+   } else if (d >= 1.0 - gofw_Epsilonp1) {+      printf ("   -inf   ");+   } else if (d >= 1.0 - ftab_Suspectp) {+      s = 0.5 - log10 (1.0 - d);+      if (s > 9)+         printf ("    ");+      else+         printf ("     ");+      printf ("-%1d    ", s);+   } else {+      printf ("           ");+   }+}+++/*-------------------------------------------------------------------------*/++static void PrintLog10Tex (double d)+/*+ * Similar to PrintLog10, but prints in LaTex style.+ */+{+   int s;+   if (d <= gofw_Epsilonp) {+      printf (" &  $\\infty$  ");+   } else if (d <= ftab_Suspectp) {+      s = 0.5 - log10 (d);+      printf (" &  %3d   ", s);+   } else if (d >= 1.0 - gofw_Epsilonp1) {+      printf (" & $-\\infty$ ");+   } else if (d >= 1.0 - ftab_Suspectp) {+      s = 0.5 - log10 (1.0 - d);+      if (s > 9)+         printf (" &  $-");+      else+         printf (" &   $-");+      printf ("%1d $ ", s);+   } else {+      printf (" &        ");+   }+}+++/*=========================================================================*/++static void PrintVal (ftab_Table * T, double d, ftab_FormType Form)+/*+ * Prints the value d according to format Form.+ */+{+   int s;+   /* All Table tables are initialized to -1; thus the test was not done for +      this pair (e, f) if d = -1. */+   if (d < -0.9) {+      printf ("      ---  ");+   } else if (Form == ftab_String) {+      printf ("   ");+      s = 0.5 + d;+      printf ("%s", T->Strings[s]);+   } else if (Form == ftab_Integer) {+      printf ("   ");+      if (d <= LONG_MAX)+         printf ("%8ld", (long) d);+      else+         num_WriteD (d, 8, 0, 0);+   } else if (Form == ftab_Real) {+      printf ("   ");+      num_WriteD (d, 8, 2, 2);+   } else if (Form == ftab_pLog2) {+      PrintLog2 (d);+   } else if (Form == ftab_pLog10) {+      PrintLog10 (d);+   } else if (d < gofw_Epsilonp) {+      printf ("      eps  ");+   } else if (d < ftab_Suspectp) {+      printf ("   ");+      num_WriteD (d, 8, 2, 2);+   } else if (d > 1.0 - gofw_Epsilonp1 && Form == ftab_pVal2) {+      printf ("     -eps1  ");+   } else if (d > 1.0 - ftab_Suspectp && Form == ftab_pVal2) {+      printf ("   ");+      num_WriteD (d - 1.0, 8, 2, 2);+   } else if (Form == ftab_NotInit) {+      util_Error ("ftab_PrintTable:   Form is not initialized");+   } else {+      printf ("           ");+   }+}+++/*=========================================================================*/++static void PrintValTex (ftab_Table * T, double d, ftab_FormType Form)+/*+ * Similar to PrintVal, but prints in LaTex style.+ */+{+   int s;+   if (d < -0.9) {+      printf (" &   ---   ");+   } else if (Form == ftab_String) {+      printf (" & ");+      s = d + 0.5;+      printf ("%s", T->Strings[s]);+   } else if (Form == ftab_Integer) {+      printf (" & ");+      if (d <= LONG_MAX)+         printf ("%8ld", (long) d);+      else+         num_WriteD (d, 8, 0, 0);+   } else if (Form == ftab_Real) {+      printf (" & ");+      num_WriteD (d, 8, 2, 2);+   } else if (Form == ftab_pLog10) {+      PrintLog10Tex (d);+   } else if (Form == ftab_pLog2) {+      PrintLog2Tex (d);+   } else if (d < gofw_Epsilonp) {+      printf (" &   \\eps  ");+   } else if (d < ftab_Suspectp) {+      printf (" & ");+      num_WriteD (d, 8, 2, 2);+   } else if (d > 1.0 - gofw_Epsilonp1 && Form == ftab_pVal2) {+      printf (" &  \\epsm  ");+   } else if (d > 1.0 - ftab_Suspectp && Form == ftab_pVal2) {+      printf (" & ");+      num_WriteD (d - 1.0, 8, 2, 2);+   } else if (Form == ftab_NotInit) {+      util_Error ("ftab\\_PrintTable:   Form is not initialized");+   } else {+      printf (" &         ");+   }+}+++/*=========================================================================*/++static void PrintTablePlain (ftab_Table * T)+/*+ * Prints table T in plain text style, according to format Form.+ */+{+   int i, j;+   int j1 = T->j1;+   int j2 = T->j2;+   int jstep = T->jstep;+   double d;+   ftab_FormType Form = T->Form;++   printf ("%s", T->Desc);+   printf ("\n\nLSize   j =%2d", j1);+   j = j1 + jstep;+   while (j <= j2) {+      printf ("      j =%2d", j);+      j += jstep;+   }+   printf ("\n------------------------------------------------------\n");++   for (i = 0; i < T->Nr; i++) {+      printf ("%3d", T->LSize[i]);+      for (j = 0; j < T->Nc; j++) {+         d = T->Mat[i][j];+         PrintVal (T, d, Form);+      }+      printf ("\n");+   }+   printf ("\n=======================================================\n");+}+++/*=========================================================================*/++static void PrintTableTex (ftab_Table * T)+/*+ * Prints table T in Latex style, according to format Form.+ */+{+   int i, j;+   int j1 = T->j1;+   int j2 = T->j2;+   int jstep = T->jstep;+   ftab_FormType Form = T->Form;++   printf ("%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"+           "\\begin {tabular}{|c|@{\\extracolsep{10pt}}");+   j = j1;+   while (j <= j2) {+      printf ("c");+      j += jstep;+   }+   printf ("|}\n\\multicolumn{%1d", (j2 - j1) / jstep + 2);+   printf ("}{l}{\\makebox[0pt][l]{");+   PrintTexName (T->Desc);+   printf ("}}\\\\\n\\hline\nLSize & $ j=%2d", j1);+   j = j1 + jstep;+   while (j <= j2) {+      printf (" $ & $ j=%2d", j);+      j += jstep;+   }+   printf ("$  \\\\\n\\hline\n");++   for (i = 0; i < T->Nr; i++) {+      printf ("%3d  ", T->LSize[i]);+      for (j = 0; j < T->Nc; j++) {+         PrintValTex (T, T->Mat[i][j], Form);+      }+      printf (" \\\\\n");+   }+   printf ("\\hline\n\\end {tabular} \\\\\n\\medskip\n\n");+}+++/*=========================================================================*/++void ftab_PrintTable (ftab_Table * T)+{+   if (NULL == T)+      return;+   if (ftab_Style == ftab_Plain)+      PrintTablePlain (T);+   else+      PrintTableTex (T);+}+++/*=========================================================================*/++static void PrintTable2Tex (ftab_Table * T1, ftab_Table * T2, lebool Flag)+/*+ * Prints tables in Latex style, T1 according to format Form1,+ * T2 according to format Form2.+ */+{+   int i, j;+   int j1 = T1->j1;+   int j2 = T1->j2;+   int jstep = T1->jstep;+   double x;+   ftab_FormType Form1 = T1->Form;+   ftab_FormType Form2 = T2->Form;++   printf ("%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"+           "\\begin {tabular}{|c|@{\\extracolsep{10pt}}");+   j = j1;+   while (j <= j2) {+      printf ("rr|");+      j += jstep;+   }+   printf ("}\n\\multicolumn{%1d", 2 * ((j2 - j1) / jstep + 1) + 1);+   printf ("}{l}{\\makebox[0pt][l]{");+   PrintTexName (T1->Desc);+   printf ("---");+   PrintTexName (T2->Desc);+   if (Flag)+      printf (" (RATIO)");+   printf ("}}\\\\\n\\hline\n" " LSize& \\multicolumn{2}{c|}{$  j=%1d $}", j1);+   j = j1 + jstep;+   while (j <= j2) {+      printf (" & \\multicolumn{2}{c|}{$  j=%1d $}", j);+      j += jstep;+   }+   printf ("  \\\\\n\\hline\n");++   for (i = 0; i < T1->Nr; i++) {+      printf ("%3d", T1->LSize[i]);+      for (j = 0; j < T1->Nc; j++) {+         PrintValTex (T1, T1->Mat[i][j], Form1);+         x = T2->Mat[i][j];+         if (!Flag || x < -0.9)+            PrintValTex (T2, x, Form2);+         else {+            x = x / T1->Mat[i][j];+            PrintValTex (T2, x, ftab_Real);+         }+      }+      printf (" \\\\\n");+   }+   printf ("\\hline\n\\end {tabular} \\\\\n\\medskip\n\n");+}+++/*=========================================================================*/++static void PrintTable2Plain (ftab_Table * T1, ftab_Table * T2, lebool Flag)+/*+ * Prints tables in plain text style, T1 according to format Form1,+ * T2 according to format Form2.+ */+{+   int i, j;+   int j1 = T1->j1;+   int j2 = T1->j2;+   int jstep = T1->jstep;+   double x;+   ftab_FormType Form1 = T1->Form;+   ftab_FormType Form2 = T2->Form;++   printf ("%s", T1->Desc);+   printf ("---");+   printf ("%s", T2->Desc);+   if (Flag)+      printf (" (RATIO)");+   printf ("\n\n  LSize   j=%1d", j1);+   printf ("       j=%2d", j1);+   j = j1 + jstep;+   while (j <= j2) {+      printf ("       j=%2d", j);+      printf ("       j=%2d", j);+      j += jstep;+   }+   printf ("\n----------------------------------------------------\n");++   for (i = 0; i < T1->Nr; i++) {+      printf ("%3d", T1->LSize[i]);+      for (j = 0; j < T1->Nc; j++) {+         PrintVal (T1, T1->Mat[i][j], Form1);+         x = T2->Mat[i][j];+         if (!Flag || x < -0.9)+            PrintVal (T2, x, Form2);+         else {+            x = x / T1->Mat[i][j];+            PrintVal (T2, x, ftab_Real);+         }+      }+      printf ("\n");+   }+   printf ("\n=======================================================\n");+}+++/*=========================================================================*/++void ftab_PrintTable2 (ftab_Table * T1, ftab_Table * T2, lebool Flag)+{+   if (NULL == T1 || NULL == T2)+      return;+   if (ftab_Style == ftab_Plain)+      PrintTable2Plain (T1, T2, Flag);+   else+      PrintTable2Tex (T1, T2, Flag);+}
+ cbits/testu/src/gdef.c view
@@ -0,0 +1,136 @@+/*************************************************************************\+ *+ * Package:        MyLib+ * File:           gdef.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#ifdef HAVE_CONFIG_H+#include "config.h"+#endif++#include "gdef.h"+#ifdef HAVE_WINDOWS_H+   #include <windows.h>+#endif++#include <stdlib.h>+#include <stdio.h>+#include <string.h>++#ifdef HAVE_SYS_UTSNAME_H+#include <sys/utsname.h>++#else+#ifdef HAVE_UNISTD_H+#include <unistd.h>+#endif++#endif++++void gdef_GetHostName (char machine[], int n)+{+   int j;+#ifdef HAVE_SYS_UTSNAME_H+   struct utsname Z;+#else+   char *name;+#endif++   if (n <= 0 || machine == NULL)+      return;+   machine[0] = '\0';++#ifdef HAVE_SYS_UTSNAME_H+   if (uname(&Z) != -1) {+      strncpy (machine, Z.nodename, (size_t) n);+      j = strlen (machine);+      if (n - j > 2)+         strncat (machine, ", ", (size_t) 2);+      j = strlen (machine);+      if (n - j > 0)+         strncat (machine, Z.sysname, (size_t) (n - j));+      machine[n - 1] = '\0';+      return;   +   }++#else+#ifdef HAVE_UNISTD_H+   gethostname (machine, (size_t) n);+   machine[n - 1] = '\0';+   return;   ++#else+   name = getenv ("HOST");+   if (name != NULL) {+      strncpy (machine, name, (size_t) n);+      j = strlen (machine);+      machine[n - 1] = '\0';+      if (j < n - 3) {+         machine[j++] = ',';+         machine[j++] = ' ';+      }+   }+   name = getenv ("OSTYPE");+   if (name != NULL) {+      if ((int) strlen (name) < n - j)+         strncat (machine, name, (size_t) n - j);+      machine[n - 1] = '\0';+   }++#endif+#endif+}+++/*------------------------------------------------------------------------*/+#define MAXBYTES 255++void gdef_WriteHostName (void)+{+   char machine[1 + MAXBYTES] = {'\0'};+   gdef_GetHostName (machine, MAXBYTES);+   printf ("%s\n", machine);+}++#if 0+int main()+{+    struct utsname name;++    if (uname(&name) != -1)+        printf("   %s\n", name.nodename);+    else {+        fprintf(stderr, "Can't find system name\n");+        return 1;+    }+    gdef_GetHostName (0, MAXBYTES);+    gdef_WriteHostName ();+    return 0;+}+#endif
+ cbits/testu/src/gofs.c view
@@ -0,0 +1,578 @@+/*************************************************************************\+ *+ * Package:        ProbDist+ * File:           gofs.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "tables.h"+#include "num.h"+#include "num2.h"++#include "gofs.h"+#include "fdist.h"+#include "wdist.h"++#include <float.h>+#include <math.h>+#include <stdio.h>+++#define TRACE0(x) printf ("***   " #x "     ");+#define TRACE1(N, form) printf ("***   " #N " = %"#form "     ", N);++++/*---------------------------- extern variables ---------------------------*/++double gofs_MinExpected = 10.0;++double gofs_EpsilonAD = DBL_EPSILON / 2.0;++++/*---------------------------- module variables ---------------------------*/++/* Used in discontinuous distributions */+static double EpsilonD = 1.0E-15;+++++++/*-------------------------------- functions ------------------------------*/+++void gofs_ContUnifTransform (double V[], long N, wdist_CFUNC F,+                             double par[], double U[])+{+   long i;+   for (i = 1; i <= N; i++)+      U[i] = F (par, V[i]);+}++/*-------------------------------------------------------------------------*/++void gofs_DiscUnifTransform (double V[], long N, wdist_DFUNC F,+                             fmass_INFO W, double U[])+{+   long i;+   for (i = 1; i <= N; i++)+      U[i] = F (W, (long) V[i]);+}++/*-------------------------------------------------------------------------*/++void gofs_DiffD (double U[], double D[], long N1, long N2, +                 double a, double b)+{+   long i;+   D[N1 - 1] = U[N1] - a;+   for (i = N1; i < N2; i++)+      D[i] = U[i + 1] - U[i];+   D[N2] = b - U[N2];+}++/*-------------------------------------------------------------------------*/+#ifdef USE_LONGLONG++void gofs_DiffLL (longlong U[], longlong D[], long N1, long N2,+                  longlong a, longlong b)+{+   long i;+   D[N1 - 1] = U[N1] - a;+   for (i = N1; i < N2; i++)+      D[i] = U[i + 1] - U[i];+   D[N2] = b - U[N2];+}++/*-------------------------------------------------------------------------*/++void gofs_DiffULL (ulonglong U[], ulonglong D[], long N1, long N2,+                   ulonglong a, ulonglong b)+{+   long i;+   D[N1 - 1] = U[N1] - a;+   for (i = N1; i < N2; i++)+      D[i] = U[i + 1] - U[i];+   D[N2] = b - U[N2];+}++#endif+/*-------------------------------------------------------------------------*/++void gofs_DiffL (long U[], long D[], long N1, long N2, long a, long b)+{+   long i;+   D[N1 - 1] = U[N1] - a;+   for (i = N1; i < N2; i++)+      D[i] = U[i + 1] - U[i];+   D[N2] = b - U[N2];+}++/*-------------------------------------------------------------------------*/++void gofs_IterateSpacings (double V[], double S[], long N)+{+   long i;+   tables_QuickSortD (S, 0, N);+   for (i = 0; i < N; i++)+      S[N - i] = (i + 1) * (S[N - i] - S[N - i - 1]);+   S[0] = (N + 1) * S[0];+   V[1] = S[0];+   for (i = 2; i <= N; i++)+      V[i] = V[i - 1] + S[i - 1];+}++/*-------------------------------------------------------------------------*/++void gofs_PowerRatios (double U[], long N)+{+   long i;+   /* Assumes that the U[i] are already sorted in increasing order. */+   for (i = 1; i < N; i++) {+      if (U[i + 1] == 0.0 || U[i + 1] == -0.0) {+         /* util_Warning (1, "gofs_PowerRatios: 0 divisor"); */+         U[i] = 1.0;+      } else+         U[i] = pow (U[i] / U[i + 1], (double) i);+   }+   U[N] = pow (U[N], (double) N);+   tables_QuickSortD (U, 1, N);+}++/*-------------------------------------------------------------------------*/++void gofs_MergeClasses (double NbExp[], long Loc[],+                        long *smin, long *smax, long *NbClasses)+{+   long s0, j, s;+   double somme;++   *NbClasses = 0;+   s = *smin;+   while (s <= *smax) {+      /* Merge classes to ensure that the number expected in each class is+         >= gofs_MinExpected. */+      if (NbExp[s] < gofs_MinExpected) {+         s0 = s;+         somme = NbExp[s];+         while (somme < gofs_MinExpected && s < *smax) {+            NbExp[s] = 0.0;+            ++s;+            somme += NbExp[s];+         }+         NbExp[s] = somme;+         for (j = s0; j <= s; j++)+            Loc[j] = s;+      } else {+         Loc[s] = s;+      }+      ++*NbClasses;+      ++s;+   }+   *smin = Loc[*smin];++   /* Special case: the last class, if NbExp < MinExpected */+   if (NbExp[*smax] < gofs_MinExpected) {+      if (s0 > *smin)+         --s0;+      NbExp[s0] += NbExp[*smax];+      NbExp[*smax] = 0.0;+      --*NbClasses;+      for (j = s0 + 1; j <= *smax; j++)+         Loc[j] = s0;+      *smax = s0;+   }+   util_Warning (*NbClasses < 2, "gofs_MergeClasses:   NumClasses < 2.\n"+                                 "   The chi-square test is not done.");+   /*+   util_Assert (*NbClasses > 1, "gofs_MergeClasses:   NumClasses < 2");+   */+}+++/*-------------------------------------------------------------------------*/++void gofs_WriteClasses (double NbExp[], long Loc[], +                        long smin, long smax, long NbClasses)+{+   /* Writes the groupings of cells before or after a merging that has */+   /* been done by a previous call to gofs_MergeClasses.  */+   long s, s0;+   double somme;+   const double epsilon = 5.0E-16;++   /* Before merging classes or cells */+   if (NbClasses <= 0) {+      somme = 0.0;+      printf ("-----------------------------------------------\n"+              "Expected numbers per class before merging:\n\n"+              "Class s        NumExpected[s]\n");++      /* Don't print classes for which the expected number < epsilon */+      /* Instead reset smin */+      s = smin;+      while (NbExp[s] < epsilon)+         s++;+      if (s > smin) {+         smin = s;+         s--;+         printf ("<= %3ld", s);+         num_WriteD (NbExp[s], 18, 4, 4);+         printf ("\n");+      }+      /* Reset smax also */+      s0 = s = smax;+      while (NbExp[s] < epsilon)+         s--;+      if (s < smax)+         smax = s;++      /* Now print the classes with their expected numbers */+      for (s = smin; s <= smax; s++) {+         somme += NbExp[s];+         printf ("%6ld", s);+         num_WriteD (NbExp[s], 20, 4, 4);+         printf ("\n");+      }++      if (s0 > smax) {+         s = smax + 1;+         printf (">= %3ld", s);+         num_WriteD (NbExp[s], 18, 4, 4);+         printf ("\n");+      }++      printf ("\n");+      printf ("Total No. Expected = %18.2f\n\n", somme);+      return;+   }++   /* NbClasses > 0: After merging classes */+   printf ("-----------------------------------------------\n"+           "Expected numbers per class after merging:\n"+           "Number of classes: %4ld\n\n", NbClasses);+   printf ("Class s     NumExpected[s]\n");++   somme = 0.0;+   for (s = smin; s <= smax; s++) {+      if (Loc[s] == s) {+         somme += NbExp[s];+         printf ("%4ld %18.4f\n", s, NbExp[s]);+      }+   }+   printf ("\nTotal NumExpected = %18.2f\n\n", somme);+   printf ("The groupings :\n Class s        Loc[s]\n");+   for (s = smin; s <= smax; s++) {+      if (s == smin)+         printf ("<= ");+      else if (s == smax)+         printf (">= ");+      else+         printf ("   ");+      printf ("%4ld  %12ld\n", s, Loc[s]);+   }+   printf ("\n\n");+}+++/*-------------------------------------------------------------------------*/++/*******************************\++  Computing EDF test statistics ++\*******************************/+++double gofs_Chi2 (double NbExp[], long Count[], long smin, long smax)+{+   double Diff, Khi;+   long s;++   Khi = 0.0;+   for (s = smin; s <= smax; s++) {+      if (NbExp[s] <= 0.0) {+         util_Assert (Count[s] == 0,+            "gofs_Chi2:   NbExp[s] = 0 and Count[s] > 0");+      } else {+         Diff = Count[s] - NbExp[s];+         Khi += Diff * Diff / NbExp[s];+      }+   }+   return Khi;+}++/*-------------------------------------------------------------------------*/++double gofs_Chi2Equal (double NbExp, long Count[], long smin, long smax)+{+   double Diff, Khi;+   long s;+   Khi = 0.0;+   for (s = smin; s <= smax; s++) {+      Diff = Count[s] - NbExp;+      Khi += Diff * Diff;+   }+   return Khi / NbExp;+}++/*-------------------------------------------------------------------------*/++long gofs_Scan (double U[], long N, double d)+{+   long m, j = 1, i = 0;+   double High;++   High = 0.0;+   m = 1;+   while (j < N && High < 1.0) {+      ++i;+      /* Low = U[i]; */+      High = U[i] + d;+      while (j <= N && U[j] < High)+         ++j;+      /* j is now the index of the first obs. to the right of High. */+      if (j - i > m)+         m = j - i;+   }+   /* p-value = fbar_Scan (N, d, m); */+   return m;+}++/*-------------------------------------------------------------------------*/++double gofs_CramerMises (double U[], long N)+{+   long i;+   double W, W2;++   if (N <= 0) {+      util_Warning (TRUE, "gofs_CramerMises:   N <= 0");+      return 0.0;+   }++   W2 = 1.0 / (12 * N);+   for (i = 1; i <= N; i++) {+      W = U[i] - (i - 0.5) / N;+      W2 += W * W;+   }+   return W2;+   /* p-value = fbar_CramerMises (N, W2); */+}++/*-------------------------------------------------------------------------*/++double gofs_WatsonG (double U[], long N)+{+   long i;+   double SumZ;+   double D2;+   double DP, G;+   double UnSurN = 1.0 / N;++   if (N <= 0) {+      util_Warning (TRUE, "gofs_WatsonG:   N <= 0");+      return 0.0;+   }++   /* degenerate case N = 1 */+   if (N == 1)+      return 0.0;++   /* We assume that U is already sorted.  */+   DP = SumZ = 0.0;+   for (i = 1; i <= N; i++) {+      D2 = i * UnSurN - U[i];+      if (D2 > DP)+         DP = D2;+      SumZ += U[i];+   }+   SumZ = SumZ * UnSurN - 0.5;+   G = sqrt ((double) N) * (DP + SumZ);+   return G;+   /* p-value = fbar_WatsonG (N, G); */+}++/*-------------------------------------------------------------------------*/++double gofs_WatsonU (double U[], long N)+{+   long i;+   double SumZ, W, W2, U2;++   if (N <= 0) {+      util_Warning (TRUE, "gofs_WatsonU:   N <= 0");+      return 0.0;+   }++   /* degenerate case N = 1 */+   if (N == 1) {+      return 1.0 / 12.0;+   }++   SumZ = 0.0;+   W2 = 1.0 / (12 * N);+   for (i = 1; i <= N; i++) {+      SumZ += U[i];+      W = U[i] - (i - 0.5) / N;+      W2 += W * W;+   }+   SumZ = SumZ / N - 0.5;+   U2 = W2 - SumZ * SumZ * N;+   return U2;+   /* p-value = fbar_WatsonU (N, U2); */+}++/*-------------------------------------------------------------------------*/++double gofs_AndersonDarling (double V[], long N)+{+   long i;+   double U1;+   double U, A2;++   if (N <= 0) {+      util_Warning (TRUE, "gofs_AndersonDarling:   N <= 0");+      return 0.0;+   }++   A2 = 0.0;+   for (i = 1; i <= N; i++) {+      U1 = U = V[i];+      if (U <= gofs_EpsilonAD) {+         U1 = U = gofs_EpsilonAD;+      } else if (U >= 1 - gofs_EpsilonAD)+         U1 = 1.0 - gofs_EpsilonAD;+      A2 += (2 * i - 1) * log (U) + (1 + 2 * (N - i)) * num2_log1p (-U1);+   }+   A2 = -N - A2 / N;+   return A2;+   /* p-value = fbar_AndersonDarling (N, A2); */+}++/*-------------------------------------------------------------------------*/++void gofs_KSJumpOne (double U[], long N, double a, double *DP, double *DM)+   /* Statistics KS+ and KS-. Case with 1 jump at a, near the lower tail of+      the distribution. */+{+   long j, i;+   double D2, D1, UnSurN;++   if (N <= 0) {+      *DP = *DM = 0.0;+      util_Warning (TRUE, "gofs_KSJumpOne:   N <= 0");+      return;+   }++   *DP = 0.0;+   *DM = 0.0;+   UnSurN = 1.0 / N;+   j = 1;+   while (j < N && U[j] <= a + EpsilonD)+      ++j;+   for (i = j - 1; i <= N; i++) {+      if (i >= 1) {+         D1 = i * UnSurN - U[i];+         if (D1 > *DP)+            *DP = D1;+      }+      if (i >= j) {+         D2 = U[i] - (i - 1) * UnSurN;+         if (D2 > *DM)+            *DM = D2;+      }+   }+}++/*-------------------------------------------------------------------------*/++void gofs_KS (double U[], long N, double *DP, double *DM, double *D)+{+   if (N <= 0) {+      *DP = *DM = *D = 0.0;+      util_Warning (TRUE, "gofs_KS:   N <= 0");+      return;+   }++   gofs_KSJumpOne (U, N, 0.0, DP, DM);+   if (*DM > *DP)+      *D = *DM;+   else+      *D = *DP;+   /*   pp = fbar_KSPlus (N, *DP);+        pm = fbar_KSPlus (N, *DM);+        p  = fbar_KS (N, *D);      */+}++/*-------------------------------------------------------------------------*/+#if 0++void gofs_KSJumpsMany (double X[], int N, wdist_CFUNC F, double W[],+                       double *DP, double *DM, int Detail)+{+   int i;+   double y, UnSurN, D;++   if (N <= 0) {+      *DP = *DM = 0.0;+      util_Warning (TRUE, "gofs_KSJumpsMany:   N <= 0");+      return;+   }++   util_Assert (N > 0, "gofs_KSJumpsMany:   N <= 0");+   UnSurN = 1.0 / N;+   *DP = 0.0;+   *DM = 0.0;++   if (Detail > 0) {+      printf ("-----------------------------------------------\n"+              "Values of the distribution F(x+0) :\n\n");+   }+   /* Assume that the X[i] are already sorted */+   for (i = 1; i <= N; i++) {+      /* Compute KS+ */+      y = F (W, X[i]);+      D = i * UnSurN - y;+      if (D > *DP)+         *DP = D;+      if (Detail > 0) {+         printf ("%14.6f  %14.6f\n", X[i], y);+      }+      /* Compute KS- */+      y = F (W, X[i] - EpsilonD);+      D = y - (i - 1) * UnSurN;+      if (D > *DM)+         *DM = D;+   }+   if (Detail > 0)+      printf ("\n\n");+}+#endif
+ cbits/testu/src/gofw.c view
@@ -0,0 +1,706 @@+/*************************************************************************\+ *+ * Package:        ProbDist+ * File:           gofw.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/+++#include "gofw.h"+#include "gofs.h"+#include "fdist.h"+#include "wdist.h"+#include "fbar.h"++#include "util.h"+#include "num.h"+#include "tables.h"+#include "mystr.h"+#include "bitset.h"++#include <float.h>+#include <string.h>+#include <stdio.h>+#include <math.h>+++++/*---------------------------- extern variables ----------------------------*/++gofw_GraphType gofw_GraphSoft = gofw_Gnuplot;++double gofw_Suspectp = 0.001;++double gofw_Epsilonp = 1.0E-300;+double gofw_Epsilonp1 = 1.0E-15;++char *gofw_TestNames[gofw_NTestTypes] = {+   "KSPlus", "KSMinus", "KS", "Anderson-Darling",+   "Cramer-vonMises", "Watson G", "Watson U",+   "Mean", "Variance", "Correlation", "Sum"+};++bitset_BitSet gofw_ActiveTests = (bitset_BitSet) 0 |+   (1U << gofw_KSP) | (1U << gofw_KSM) | (1U << gofw_AD);++++/*---------------------------- module variables ----------------------------*/++#define LEN1 100+#define LEN2 10++static char desc[LEN1];+static char str[LEN2];+++++/*--------------------------------------------------------------------------*/++static void printMath2 (FILE * f, double x, double y)+{+   /* Writes the pair (x, y) in file f, in a format understood */+   /* by Mathematica */+   char S[41];++   fprintf (f, "   { ");+   if ((x != 0.0) && (x < 0.1 || x > 1.0)) {+      sprintf (S, "%16.7E", x);+      mystr_Subst (S, "E", "*10^(");+      strcat (S, ")");+   } else {+      sprintf (S, "%16.8g", x);+   }+   fprintf (f, ",     ");++   if (y != 0.0 && (y < 0.1 || y > 1.0)) {+      sprintf (S, "%16.7E", y);+      mystr_Subst (S, "E", "*10^(");+      strcat (S, ")");+   } else {+      sprintf (S, "%16.8g", y);+   }+   fprintf (f, " }");+}++/*--------------------------------------------------------------------------*/++void gofw_GraphDistUnif (FILE * f, double U[], long N, char Desc[])+{+   long i;+   double UnSurN = 1.0 / N;+   if (f == NULL)+      f = stdout;++   switch (gofw_GraphSoft) {++   case gofw_Gnuplot:+      fprintf (f, "#----------------------------------\n");+      fprintf (f, "# %-70s\n\n", Desc);+      fprintf (f, "%16.8g  %16.8g\n", 0.0, 0.0);+      for (i = 1; i <= N; i++)+         fprintf (f, "%16.8g  %16.8g\n", U[i], i * UnSurN);+      fprintf (f, "%16.8g  %16.8g\n\n", 1.0, 1.0);+      break;++   case gofw_Mathematica:+      fprintf (f, "(*----------------------------------*)\n");+      fprintf (f, "(* %-70s\n *)\n\npoints = { \n", Desc);+      printMath2 (f, 0.0, 0.0);+      fprintf (f, ",\n");+      for (i = 1; i <= N; i++) {+         printMath2 (f, U[i], i * UnSurN);+         fprintf (f, ",\n");+      }+      printMath2 (f, 1.0, 1.0);+      fprintf (f, "\n}\n\n");+      break;++   default:+      util_Error ("gofw_GraphDistUnif:   gofw_GraphSoft unknown");+      break;+   }+}+++/*--------------------------------------------------------------------------*/++void gofw_GraphFunc (FILE *f, wdist_CFUNC F, double par[], double a,+                     double b, int M, int mono, char Desc[])+{+   int i;+   double yprec, y, x, h;+   if (f == NULL)+      f = stdout;++   switch (gofw_GraphSoft) {++      /* Il y a trop de repetition de code ici.  */+   case gofw_Gnuplot:+      fprintf (f, "#----------------------------------\n");+      fprintf (f, "# %-70s\n\n", Desc);+      h = (b - a) / M;+      if (mono == 1)+         yprec = -DBL_MAX;+      else if (mono == -1)+         yprec = DBL_MAX;+      else+         yprec = 0.0;+      for (i = 0; i <= M; i++) {+         x = a + i * h;+         y = F (par, x);+         fprintf (f, "%16.8g      %16.8g", x, y);+         switch (mono) {+         case 1:+            if (y < yprec)+               fprintf (f, "    #  DECREASING");+            break;+         case -1:+            if (y > yprec)+               fprintf (f, "    #  INCREASING");+            break;+         default:+            break;+         }+         fprintf (f, "\n");+         yprec = y;+      }+      fprintf (f, "\n");+      break;++   case gofw_Mathematica:+      fprintf (f, "(*----------------------------------*)\n");+      fprintf (f, "(* %-70s\n *)\n\npoints = { \n", Desc);+      h = (b - a) / M;+      if (mono == 1)+         yprec = -DBL_MAX;+      else if (mono == -1)+         yprec = DBL_MAX;+      else+         yprec = 0.0;+      for (i = 0; i <= M; i++) {+         x = a + i * h;+         y = F (par, x);+         printMath2 (f, x, y);+         if (i < M)+            fprintf (f, ",");++         switch (mono) {+         case 1:+            if (y < yprec)+               fprintf (f, "   (* DECREASING *)");+            break;+         case -1:+            if (y > yprec)+               fprintf (f, "   (* INCREASING *)");+            break;+         default:+            break;+         }+         fprintf (f, "\n");+         yprec = y;+      }+      fprintf (f, "}\n\n");+      break;++   default:+      util_Error ("gofw_GraphFunc:   gofw_GraphSoft unknown");+      break;+   }+}+++/*--------------------------------------------------------------------------*/++double gofw_pDisc (double pLeft, double pRight)+{+   double p;++   if (pRight < pLeft)+      p = pRight;+   else if (pLeft > 0.5)+      p = 0.5;+   else+      p = 1.0 - pLeft;+   /* Note: si p est tres proche de 1, on perd toute la precision ici! */+   /* Note2: je ne pense pas que cela puisse se produire a cause des if (RS) +    */+   return p;+}+++/*--------------------------------------------------------------------------*/++void gofw_Writep0 (double p)+   /* Prints the significance level of a test, without a descriptor */+{+   if ((p >= 0.01) && (p <= 0.99))+      num_WriteD (p, 8, 2, 1);+   else if (p < gofw_Epsilonp)+      printf ("   eps  ");+   else if (p < 0.01)+      num_WriteD (p, 8, 2, 2);+   else if (p >= 1.0 - gofw_Epsilonp1)+      printf (" 1 - eps1");+   else if (p < 1.0 - 1.0e-4)+      printf ("    %.4f", p);+   else {+      printf (" 1 - ");+      num_WriteD (1.0 - p, 7, 2, 2);+   }+}+++/*--------------------------------------------------------------------------*/++void gofw_Writep1 (double p)+   /* Prints the significance level of a test, with a descriptor. */+{+/* printf ("Significance level of test            :"); */+   printf ("p-value of test                       :");+   gofw_Writep0 (p);+   if (p < gofw_Suspectp || p > 1.0 - gofw_Suspectp) {+      printf ("    *****");+   }+   printf ("\n\n");+}+++/*--------------------------------------------------------------------------*/++void gofw_Writep2 (double x, double p)+   /* Prints the statistic x and its significance level p. */+{+   if ((x < 1.0e5 && x >= 0.1) || (x > -1.0e4 && x <= -0.1))+      num_WriteD (x, 8, 2, 1);+   else if ((x < 0.1 && x >= 0.01) || (x > -0.1 && x <= -0.01))+      num_WriteD (x, 8, 3, 2);+   else+      num_WriteD (x, 8, 3, 3);+   printf ("\n");+   gofw_Writep1 (p);+}+++/*--------------------------------------------------------------------------*/++void gofw_WriteKS0 (long N, double DP, double DM, double D)+   /* Prints the results of a Kolmogorov-Smirnov test */+{+   printf ("\n\nKolmogorov-Smirnov+ statistic = D+    :");+   gofw_Writep2 (DP, fbar_KSPlus (N, DP));+   printf ("Kolmogorov-Smirnov- statistic = D-    :");+   gofw_Writep2 (DM, fbar_KSPlus (N, DM));+   printf ("Kolmogorov-Smirnov statistic = D      :");+   gofw_Writep2 (D, fbar_KS1 (N, D));+   printf ("\n\n");+}+++/*--------------------------------------------------------------------------*/++void gofw_WriteKS1 (double V[], long N, wdist_CFUNC F, double par[])+{+   double *U;+   double D, DM, DP;++   U = (double *) util_Calloc ((size_t) N + 1, sizeof (double));+   gofs_ContUnifTransform (V, N, F, par, U);+   tables_QuickSortD (U, 1, N);+   gofs_KS (U, N, &DP, &DM, &D);+   gofw_WriteKS0 (N, DP, DM, D);+   util_Free (U);+}+++/*--------------------------------------------------------------------------*/++void gofw_WriteKSJumpOne0 (long N, double a, double DP)+{+   double d;++   printf ("\nKolmogorov-Smirnov+ statistic = D+    :%8.2g\n", DP);+   d = 1.0 - fdist_KSPlusJumpOne (N, a, DP);+   gofw_Writep1 (d);+   printf ("\n");+}+++/*--------------------------------------------------------------------------*/++void gofw_WriteKSJumpOne1 (double V[], long N, wdist_CFUNC F, double par[],+                           double a)+{+   double *U;+   double DP, DM;++   U = (double *)util_Calloc ((size_t) N + 1, sizeof (double));+   gofs_ContUnifTransform (V, N, F, par, U);+   tables_QuickSortD (U, 1, N);+   gofs_KSJumpOne (U, N, a, &DP, &DM);+   gofw_WriteKSJumpOne0 (N, a, DP);+   util_Free (U);+}+++/*--------------------------------------------------------------------------*/++#if 0++void gofw_KSJumpsMany0 (double DP, double DM, fdist_FUNC_JUMPS * H)+{+   double d;++   printf ("\nKolmogorov-Smirnov+ statistic = D+    :%8.2g\n", DP);+   d = 1.0 - fdist_KSPlusJumpsMany (H, DP);+   gofw_Desc1 (d);++   printf ("\nKolmogorov-Smirnov- statistic = D-    :%8.2g\n", DM);+   d = 1.0 - fdist_KSMinusJumpsMany (H, DM);+   gofw_Desc1 (d);+   printf ("\n");+}+++/*--------------------------------------------------------------------------*/++void gofw_KSJumpsMany2 (statcoll_Collector *S, fdist_FUNC_JUMPS *H,+                        int Detail)+{+   double DM, DP;+   double *X;+   wdist_CFUNC F = H->F;+   double *W = H->par;++   /* The implementation of fdist_KSPlusJumpsMany and fdist_KSMinusJumpsMany+      works only for NObs <= 64: instability for larger NObs.  */+   if (S->NObs > 64) {+      printf ("\nKolmogorov-Smirnov, sample too large\n\n\n"+	      "------------------------------------------\n");+      return;+   }++   X = (double *) util_Calloc (1 + (size_t) S->NObs, sizeof (double));+   tables_CopyTabD (S->St, X, 1, S->NObs);+   tables_QuickSortD (X, 1, S->NObs);+   statcalc_KSJumpsMany (X, S->NObs, F, W, &DP, &DM, Detail);+   gofw_KSJumpsMany0 (DP, DM, H);+   util_Free (X);+   printf ("\n");+}++#endif+/*--------------------------------------------------------------------------*/++void gofw_InitTestArray (gofw_TestArray A, double x)+{+   int i;+   for (i = 0; i < gofw_NTestTypes; i++)+      A[i] = x;+}+++/*--------------------------------------------------------------------------*/++void gofw_Tests0 (double U[], long N, gofw_TestArray sVal)+{+   long i;+   double A2 = 0.0, W2, DM = 0.0, DP = 0.0, W;+   double U1, Ui, D2, D1;+   double SumZ;+   double UnSurN;++   util_Assert (N > 0, "gofw_Tests0:   N <= 0");++   /* We assume that U is already sorted. */+   if (N == 1) {+      sVal[gofw_KSP] = 1.0 - U[1];+      sVal[gofw_Mean] = U[1];+      return;+   }+   UnSurN = 1.0 / N;+   W2 = UnSurN / 12.0;+   SumZ = 0.0;+   for (i = 1; i <= N; i++) {+      /* Statistics KS */+      D1 = U[i] - (i - 1) * UnSurN;+      D2 = i * UnSurN - U[i];+      if (D1 > DM)+         DM = D1;+      if (D2 > DP)+         DP = D2;+      /* Watson U and G */+      SumZ += U[i];+      W = U[i] - (i - 0.5) * UnSurN;+      W2 += W * W;+      /* Anderson-Darling */+      Ui = U[i];+      U1 = 1.0 - Ui;+      if (Ui < gofs_EpsilonAD)+         Ui = gofs_EpsilonAD;+      else if (U1 < gofs_EpsilonAD)+         U1 = gofs_EpsilonAD;+      A2 += (2 * i - 1) * log (Ui) + (1 + 2 * (N - i)) * log (U1);+   }+   if (DM > DP)+      sVal[gofw_KS] = DM;+   else+      sVal[gofw_KS] = DP;+   sVal[gofw_KSM] = DM;+   sVal[gofw_KSP] = DP;+   SumZ = SumZ * UnSurN - 0.5;+   sVal[gofw_CM] = W2;+   sVal[gofw_WG] = sqrt ((double) N) * (DP + SumZ);+   sVal[gofw_WU] = W2 - SumZ * SumZ * N;+   sVal[gofw_AD] = -N - A2 * UnSurN;+/*   sVal[gofw_Mean] = SumZ + 0.5; */ /* Nouveau ... */+}++/*-------------------------------------------------------------------------*/++void gofw_Tests1 (double V[], long N, wdist_CFUNC F, double par[],+                  gofw_TestArray sVal)+{+   double *U;+   util_Assert (N > 0, "gofw_Tests1:   N <= 0");+   U = (double *) util_Calloc ((size_t) N + 1, sizeof (double));+   gofs_ContUnifTransform (V, N, F, par, U);+   tables_QuickSortD (U, 1, N);+   gofw_Tests0 (U, N, sVal);+   if (N == 1)+      sVal[gofw_Mean] = V[1];   /* On veut V[1], pas U[1] */+   util_Free (U);+}++/*-------------------------------------------------------------------------*/++void gofw_ActiveTests0 (double U[], long N, +                        gofw_TestArray sVal, gofw_TestArray pVal)+{+   util_Assert (N > 0, "gofw_ActiveTests0:   N <= 0");+   if (N == 1) {+      sVal[gofw_Mean] = U[1];+      pVal[gofw_Mean] = 1.0 - U[1];+      sVal[gofw_KSP] = 1.0 - U[1];+      pVal[gofw_KSP] = 1.0 - U[1];+      pVal[gofw_AD] = -1.0;        /* My bug detector */+      return;+   }+   /* We assume that U is already sorted.  */+   gofw_Tests0 (U, N, sVal);++   if (bitset_TestBit (gofw_ActiveTests, gofw_KSP))+      pVal[gofw_KSP] = fbar_KSPlus (N, sVal[gofw_KSP]);++   if (bitset_TestBit (gofw_ActiveTests, gofw_KSM))+      pVal[gofw_KSM] = fbar_KSPlus (N, sVal[gofw_KSM]);++   if (bitset_TestBit (gofw_ActiveTests, gofw_KS))+      pVal[gofw_KS] = fbar_KS1 (N, sVal[gofw_KS]);++   if (bitset_TestBit (gofw_ActiveTests, gofw_AD))+      pVal[gofw_AD] = fbar_AndersonDarling (N, sVal[gofw_AD]);++   if (bitset_TestBit (gofw_ActiveTests, gofw_CM))+      pVal[gofw_CM] = fbar_CramerMises (N, sVal[gofw_CM]);++   if (bitset_TestBit (gofw_ActiveTests, gofw_WG))+      pVal[gofw_WG] = fbar_WatsonG (N, sVal[gofw_WG]);++   if (bitset_TestBit (gofw_ActiveTests, gofw_WU))+      pVal[gofw_WU] = fbar_WatsonU (N, sVal[gofw_WU]);+}++/*-------------------------------------------------------------------------*/++void gofw_ActiveTests1 (double V[], long N, wdist_CFUNC F, double par[],+                        gofw_TestArray sVal, gofw_TestArray pVal)+{+   double *U;+   util_Assert (N > 0, "gofw_ActiveTests1:   N <= 0");+   U = (double *) util_Calloc ((size_t) N + 1, sizeof (double));+   gofs_ContUnifTransform (V, N, F, par, U);+   tables_QuickSortD (U, 1, N);+   gofw_ActiveTests0 (U, N, sVal, pVal);+   if (N == 1)+      sVal[gofw_Mean] = V[1];+   util_Free (U);+}++/*-------------------------------------------------------------------------*/++void gofw_ActiveTests2 (double V[], double U[], long N, wdist_CFUNC F,+   double par[], gofw_TestArray sVal, gofw_TestArray pVal)+{+   util_Assert (N > 0, "gofw_ActiveTests1:   N <= 0");+   tables_QuickSortD (V, 1, N);+   gofs_ContUnifTransform (V, N, F, par, U);+   gofw_ActiveTests0 (U, N, sVal, pVal);+   if (N == 1)+      sVal[gofw_Mean] = V[1];+}++/*-------------------------------------------------------------------------*/++void gofw_WriteActiveTests0 (long N, gofw_TestArray sVal,+                             gofw_TestArray pVal)+{+   if (N == 1) {+      gofw_Writep1 (pVal[gofw_KSP]);+      return;+   }+   printf ("\n");+   if (bitset_TestBit (gofw_ActiveTests, gofw_KSP)) {+      printf ("Kolmogorov-Smirnov+ statistic = D+    :");+      gofw_Writep2 (sVal[gofw_KSP], pVal[gofw_KSP]);+   }+   if (bitset_TestBit (gofw_ActiveTests, gofw_KSM)) {+      printf ("Kolmogorov-Smirnov- statistic = D-    :");+      gofw_Writep2 (sVal[gofw_KSM], pVal[gofw_KSM]);+   }+   if (bitset_TestBit (gofw_ActiveTests, gofw_KS)) {+      printf ("Kolmogorov-Smirnov statistic  = D     :");+      gofw_Writep2 (sVal[gofw_KS], pVal[gofw_KS]);+   }+   if (bitset_TestBit (gofw_ActiveTests, gofw_AD)) {+      printf ("Anderson-Darling statistic = A2       :");+      gofw_Writep2 (sVal[gofw_AD], pVal[gofw_AD]);+   }+   if (bitset_TestBit (gofw_ActiveTests, gofw_CM)) {+      printf ("Cramer-von Mises statistic = W2       :");+      gofw_Writep2 (sVal[gofw_CM], pVal[gofw_CM]);+   }+   if (bitset_TestBit (gofw_ActiveTests, gofw_WG)) {+      printf ("Watson statistic = G                  :");+      gofw_Writep2 (sVal[gofw_WG], pVal[gofw_WG]);+   }+   if (bitset_TestBit (gofw_ActiveTests, gofw_WU)) {+      printf ("Watson statistic = U2                 :");+      gofw_Writep2 (sVal[gofw_WU], pVal[gofw_WU]);+   }+}+++/*--------------------------------------------------------------------------*/++void gofw_WriteActiveTests1 (double V[], long N, wdist_CFUNC F, double par[])+{+   gofw_TestArray sv, pv;++   gofw_ActiveTests1 (V, N, F, par, sv, pv);+   gofw_WriteActiveTests0 (N, sv, pv);+}+++/*--------------------------------------------------------------------------*/++void gofw_WriteActiveTests2 (long N, gofw_TestArray sVal,+   gofw_TestArray pVal, char S[])+{+   printf ("\n-----------------------------------------------\n");+   if (N == 1) {+      gofw_Writep2 (sVal[gofw_Mean], pVal[gofw_Mean]);+   } else {+      gofw_WriteActiveTests0 (N, sVal, pVal);+   }+}+++/*--------------------------------------------------------------------------*/++void gofw_IterSpacingsTests0 (double U[], long N, int k,+   lebool printval, lebool graph, FILE * f)+   /* Assumes that U is sorted.  */+{+   int j;+   long i;+   double *S, *UU;+   gofw_TestArray sVal, pVal;++   UU = (double *) util_Calloc (1 + (size_t) N, sizeof (double));+   S = (double *) util_Calloc (1 + (size_t) N, sizeof (double));+   printf ("\n");+   for (i = 1; i <= N; i++)+      UU[i] = U[i];               /* UU is a copy of U */+   for (j = 1; j <= k; j++) {+      printf ("-----------------------------------\n"+         "EDF Tests after \"gofw_IterateSpacings\", level :%2d\n", j);+      gofs_DiffD (UU, S, 1, N, 0.0, 1.0);+      gofs_IterateSpacings (UU, S, N);+      tables_QuickSortD (UU, 1, N);+      gofw_ActiveTests0 (UU, N, sVal, pVal);+      gofw_WriteActiveTests0 (N, sVal, pVal);+      strncpy (desc, "Values of Uniforms after IterateSpacings, level ",+         (size_t) LEN1);+      sprintf (str, "%2d", j);+      strncat (desc, str, (size_t) LEN2);+      if (printval > 0)+         tables_WriteTabD (UU, 1, N, 5, 15, 6, 6, desc);+      if (graph > 0)+         gofw_GraphDistUnif (f, UU, N, desc);+   }+   util_Free (UU);+   util_Free (S);+}+++/*--------------------------------------------------------------------------*/+++void gofw_IterPowRatioTests0 (double U[], long N, int k,+   lebool printval, lebool graph, FILE * f)+{+   int i;+   long j;+   double *UU;+   gofw_TestArray sVal, pVal;++   UU = (double *) util_Calloc (1 + (size_t) N, sizeof (double));+   printf ("\n");+   for (j = 1; j <= N; j++)+      UU[j] = U[j];+   for (i = 1; i <= k; i++) {+      gofs_PowerRatios (UU, N);+      printf ("-----------------------------------\n"+              "EDF Tests after \"gofw_PowerRatios\", level :%2d\n", i);+      tables_QuickSortD (UU, 1, N);+      gofw_ActiveTests0 (UU, N, sVal, pVal);+      gofw_WriteActiveTests0 (N, sVal, pVal);+      strncpy (desc, "Values of Uniforms after PowerRatios, level ",+               (size_t) LEN1);+      sprintf (str, "%2d", i);+      strncat (desc, str, (size_t) LEN2);+      if (printval > 0)+         tables_WriteTabD (UU, 1, N, 5, 15, 6, 6, desc);+      if (graph > 0)+         gofw_GraphDistUnif (f, UU, N, desc);+   }+   util_Free (UU);+}++/*--------------------------------------------------------------------------*/
+ cbits/testu/src/mystr.c view
@@ -0,0 +1,171 @@+/*************************************************************************\+ *+ * Package:        MyLib+ * File:           mystr.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "mystr.h"+#include <stdio.h>+#include <ctype.h>+#include <string.h>+++void mystr_Delete (char S[], unsigned int index, unsigned int len)+{+   int i;+   unsigned int length = strlen (S);+   if (index + len > length)+      S[index] = '\0';+   else+      for (i = index; (unsigned int) i <= length - len; ++i)+         S[i] = S[i + len];+}+++void mystr_Insert (char Res[], char Source[], unsigned int Pos)+{+   int i;+   unsigned int ResLength = strlen (Res);+   unsigned int SourceLength = strlen (Source);+   if (Pos > ResLength)+      util_Error ("mystr_Insert : Index out of array bound.");+   for (i = ResLength; (unsigned) i >= Pos; --i) {+      Res[i + SourceLength] = Res[i]; /* end of Res */+   }+   for (i = Pos; (unsigned) i < Pos + SourceLength; ++i)+      Res[i] = Source[i - Pos];      /* adding Source to Res */+}+++void mystr_ItemS (char R[], char S[], const char T[], unsigned int N)+{+   unsigned int i;+   char *temp;+   temp = strtok (S, T);             /* first time */+   for (i = 1; i <= N; ++i) {        /* 2nd to Nth time */+      if (temp == NULL)+         break;+      temp = strtok (NULL, T);+   }+   if (temp == NULL) {+      strncpy (R, "\0", (size_t) 1);+      return;+   }+   strcpy (R, temp);                 /* assignation */+}+++static int mystr_Rmatch (char s[], unsigned int i, char p[], unsigned int j)+{+   int matched;+   unsigned int k;+   unsigned int s_len = strlen (s);+   unsigned int p_len = strlen (p);+   if (p[0] == 0)+      return 1;+   for (;;) {+      if ((i > s_len - 1 || s[i] == 0) && (j > p_len - 1 || p[j] == 0))+         return 1;+      if (j > p_len - 1 || p[j] == 0)+         return 0;+      if (p[j] == '*') {+         k = i;+         if (j == p_len - 1 || p[j + 1] == 0)+            return 1;+         else {+            for (;;) {+               matched = mystr_Rmatch (s, k, p, j + 1);+               if ((matched || k > s_len - 1) || s[k] == 0)+                  return matched;+               ++k;+            }+         }+      }+      if ((p[j] == '?' && s[i]) || (toupper (p[j]) == toupper (s[i]))) {+         ++i;+         ++j;+      } else+         return 0;+   }+   return 0;+}+++int mystr_Match (char Source[], char Pattern[])+/*+   returns TRUE if the string in Source matches the string in Pattern+   The pattern may contain any number of the wild characters '*' and '?'+   '?' matches any single character+   '*' matches any sequence of charcters (including a zero length sequence)+   EG '*m?t*i*' will match 'Automatic'+ */+{+   return mystr_Rmatch (Source, 0, Pattern, 0);+}+++void mystr_Slice (char R[], char S[], unsigned int P, unsigned int L)+{+   unsigned int i;+   if (P + L > strlen (S))+      util_Error ("*** ERROR : mystr_Slice Pattern longer then Source");+   for (i = 0; i < L; i++) {+      R[i] = S[i + P];+   }+   if (L <= strlen (R) - 1)+      R[L] = 0;+}+++void mystr_Subst (char source[], char OldPattern[], char NewPattern[])+{+   unsigned int len;+   unsigned int index;+   char *PatternFound;+   PatternFound = strstr (source, OldPattern);+   if (PatternFound != NULL) {+      len = strlen (OldPattern);+      index = PatternFound - source;+      mystr_Delete (source, index, len);+      mystr_Insert (source, NewPattern, index);+   }+}+++void mystr_Position (char Substring[], char Source[], unsigned int at,+                     unsigned int *pos, int *found)+{+   char *result = strstr (Source + at, Substring);+   if (at > strlen (Source))+      util_Error ("mystr_Position : Index out of array bound.");+   if (result != NULL) {+      *pos = result - Source;+      *found = 1;+   } else+      *found = 0;+}
+ cbits/testu/src/num.c view
@@ -0,0 +1,412 @@+/*************************************************************************\+ *+ * Package:        MyLib+ * File:           num.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/+++#include "util.h"+#include "bitset.h"+#include "num.h"+#include <math.h>+#include <string.h>+#include <stdio.h>+#include <limits.h>+++++#define Deux53   9007199254740992.0  /* 2^53 */+#define Deux17   131072.0            /* 2^17 */+#define UnDeux17   7.62939453125E-6  /* 1 / 2^17 */+#define MASK32  0xffffffffUL++double num_TwoExp[num_MaxTwoExp + 1] = {+   1.0, 2.0, 4.0, 8.0, 1.6e1, 3.2e1,+   6.4e1, 1.28e2, 2.56e2, 5.12e2, 1.024e3,+   2.048e3, 4.096e3, 8.192e3, 1.6384e4, 3.2768e4,+   6.5536e4, 1.31072e5, 2.62144e5, 5.24288e5,+   1.048576e6, 2.097152e6, 4.194304e6, 8.388608e6,+   1.6777216e7, 3.3554432e7, 6.7108864e7,+   1.34217728e8, 2.68435456e8, 5.36870912e8,+   1.073741824e9, 2.147483648e9, 4.294967296e9,+   8.589934592e9, 1.7179869184e10, 3.4359738368e10,+   6.8719476736e10, 1.37438953472e11, 2.74877906944e11,+   5.49755813888e11, 1.099511627776e12, 2.199023255552e12,+   4.398046511104e12, 8.796093022208e12,+   1.7592186044416e13, 3.5184372088832e13,+   7.0368744177664e13, 1.40737488355328e14,+   2.81474976710656e14, 5.62949953421312e14,+   1.125899906842624e15, 2.251799813685248e15,+   4.503599627370496e15, 9.007199254740992e15,+   1.8014398509481984e16, 3.6028797018963968e16,+   7.2057594037927936e16, 1.44115188075855872e17,+   2.88230376151711744e17, 5.76460752303423488e17,+   1.152921504606846976e18, 2.305843009213693952e18,+   4.611686018427387904e18, 9.223372036854775808e18,+   1.8446744073709551616e19+};+++double num_TENNEGPOW[] = {+   1.0, 1.0e-1, 1.0e-2, 1.0e-3, 1.0e-4, 1.0e-5, 1.0e-6, 1.0e-7, 1.0e-8,+   1.0e-9, 1.0e-10, 1.0e-11, 1.0e-12, 1.0e-13, 1.0e-14, 1.0e-15, 1.0e-16 +};++++int num_IsNumber (char S[])+/*********************************************************+ *  Returns TRUE if the string S begin with a number     *+ *  (with the possibility of spaces and a + or - sign    *+ *  before the number).                                  *+ *  e.g.                                                 *+ *        '  + 2'   returns TRUE                         *+ *         '-+ 2'   returns FALSE                        *+ *       '4hello'   returns TRUE                         *+ *        'hello'   returns FALSE                        *+ *********************************************************/+{+   int Max;+   int i;+   int Sign;+   Max = (int) (strlen (S) - 1);+   Sign = 0;+   for (i = 0; i < Max; i++) {+      if (S[i] != ' ') {+         if (S[i] == '+' || S[i] == '-') {+            if (Sign) {+               return 0;+            }+            /* We already saw a sign */+            Sign = 1;+         } else if ((unsigned char) S[i] >= '0' &&+                    (unsigned char) S[i] <= '9') {+            return 1;+         } else {+            return 0;+         }+      }+   }                                 /* end for */+   return 0;                         /* There's no digit in S */+}                                    /* end IsNumber() */+++void num_IntToStrBase (long k, long b, char S[])+{+   int Sign;                        /* insert a '-' if TRUE */+   long Char0;+   long i;+   long total;+   long uppbound;+   if (b < 2 || b > 10) {+      util_Error ("*** Erreur: IntToStrB demande une b entre 2 et 10 ***");+   }+   Char0 = 48;+   if (k < 0) {+      Sign = 1;+      S[0] = '-';+      k = -k;+   } else {+      if (k == 0) {+         S[0] = '0';+         S[1] = '\0';+         return;+      }+      Sign = 0;+   }+   i = k;+   total = 0;+   while (i > 0) {+      i = (i / b);+      ++total;+   }+   if (Sign)+      uppbound = total + 1;+   else+      uppbound = total;+   S[uppbound] = '\0';+   for (i = 0; i < total - 1; i++) {+      S[(uppbound - i) - 1] =+         (char) ((int) fmod ((double) k, (double) b) + Char0);+      k = (long) (k / b);+   }+}+++/*=========================================================================*/++void num_Uint2Uchar (unsigned char *output, unsigned int *input, int L)+{+   int i, j;+   +   for (i = 0, j = 0; i < L; i++, j += 4) {+      output[j + 3] = (unsigned char) (input[i] & 0xff);+      output[j + 2] = (unsigned char) ((input[i] >> 8) & 0xff);+      output[j + 1] = (unsigned char) ((input[i] >> 16) & 0xff);+      output[j] = (unsigned char) ((input[i] >> 24) & 0xff);+   }+}+++/*=========================================================================*/++void num_WriteD (double x, int I, int J, int K)+{+   int PosEntier = 0,             /* Le nombre de positions occupees par la+                                     partie entiere de x */+      EntierSign,                 /* Le nombre de chiffres significatifs+                                     avant le point */+      Neg = 0;                    /* Nombre n'egatif */+   char S[100];+   char *p;++   if (x == 0.0)+      EntierSign = 1;+   else {+      EntierSign = PosEntier = floor (log10 (fabs (x)) + 1);+      if (x < 0.0)+         Neg = 1;+   }+   if (EntierSign <= 0)+      PosEntier = 1;++   if ((x == 0.0) ||+      (((EntierSign + J) >= K) && (I >= (PosEntier + J + Neg + 1))))+      printf ("%*.*f", I, J, x);++   else {                            /* On doit utiliser la notation+                                        scientifique. */+      sprintf (S, "%*.*e", I, K - 1, x);+      p = strstr (S, "e+0");+      if (NULL == p)+         p = strstr (S, "e-0");++      /* remove the 0 in e-0 and in e+0 */+      if (p) {+         p += 2;+	 while ((*p = *(p + 1)))+	    p++;+         printf (" ");            /* pour utiliser au moins I espaces */+      }+      printf ("%s", S);+   }+}+++/***************************************************************************/++void num_WriteBits (unsigned long x, int k)+{+   int i, n = CHAR_BIT * sizeof (unsigned long);+   unsigned long mask = (unsigned long) 1 << (n - 1);+   int spaces;+   lebool flag = FALSE;++   if (k > 0) {+      spaces = k - n;+      for (i = 0; i < spaces; i++)+         printf (" ");+   }+   for (i = 0; i < n; i++) {+      if (x & mask) {+         printf ("1");+         flag = TRUE;+      } else if (flag)+         printf ("0");+      else+         printf (" ");+      mask >>= 1;+   }+   if (k < 0) {+      spaces = -k - n;+      for (i = 0; i < spaces; i++)+         printf (" ");+   }+}+++/***************************************************************************/++#if LONG_MAX == 2147483647L+#define H   32768                    /* = 2^d  used in MultModL. */+#else+#define H   2147483648L  +#endif++long num_MultModL (long a, long s, long c, long m)+   /* Suppose que 0 < a < m  et  0 < s < m.   Retourne (a*s + c) % m.   */+   /* Cette procedure est tiree de :                                    */+   /* L'Ecuyer, P. et Cote, S., A Random Number Package with           */+   /* Splitting Facilities, ACM TOMS, 1991.                            */+   /* On coupe les entiers en blocs de d bits. H doit etre egal a 2^d.  */+{+   long a0, a1, q, qh, rh, k, p;+   if (a < H) {+      a0 = a;+      p = 0;+   } else {+      a1 = a / H;+      a0 = a - H * a1;+      qh = m / H;+      rh = m - H * qh;+      if (a1 >= H) {+         a1 = a1 - H;+         k = s / qh;+         p = H * (s - k * qh) - k * rh;+         if (p < 0)+            p = (p + 1) % m + m - 1;+      } else                         /* p = (A2 * s * h) % m.      */+         p = 0;+      if (a1 != 0) {+         q = m / a1;+         k = s / q;+         p -= k * (m - a1 * q);+         if (p > 0)+            p -= m;+         p += a1 * (s - k * q);+         if (p < 0)+            p = (p + 1) % m + m - 1;+      }                              /* p = ((A2 * h + a1) * s) % m. */+      k = p / qh;+      p = H * (p - k * qh) - k * rh;+      if (p < 0)+         p = (p + 1) % m + m - 1;+   }                                 /* p = ((A2 * h + a1) * h * s) % m  */+   if (a0 != 0) {+      q = m / a0;+      k = s / q;+      p -= k * (m - a0 * q);+      if (p > 0)+         p -= m;+      p += a0 * (s - k * q);+      if (p < 0)+         p = (p + 1) % m + m - 1;+   }+   p = (p - m) + c;+   if (p < 0)+      p += m;+   return p;+}++/*************************************************************************/++double num_MultModD (double a, double s, double c, double m)+{+   double V;+   long k;+   V = a * s + c;+   if (V >= Deux53 || -V >= Deux53) {+      k = a * UnDeux17;+      a -= k * Deux17;+      V = k * s;+      k = V / m;+      V -= k * m;+      V = V * Deux17 + a * s + c;+   }+   k = V / m;+   V -= k * m;+   if (V < 0)+      V += m;+   return V;+}+++/**************************************************************************/++long num_InvEuclid (long M, long x)+/*+ * Compute the inverse of x mod M by the modified Euclide+ * algorithm (Knuth V2 p. 325).+ */+{+   long u1 = 0, u3 = M, v1 = 1, v3 = x;+   long t1, t3, qq;+   if (x == 0) return 0;++   while (v3 != 0) {+      qq = u3 / v3;+      t1 = u1 - v1 * qq;+      t3 = u3 - v3 * qq;+      u1 = v1;+      v1 = t1;+      u3 = v3;+      v3 = t3;+   }+   if (u1 < 0)+      u1 += M;++   if (u3 != 1) { /* In this case, the inverse does not exist! */+      fprintf (stderr,+      "ERROR in num_InvEuclid: inverse does not exist:   m = %ld,  x = %ld\n",+            M, x);+      return 0;+   } else+     return u1;+}+++/*------------------------------------------------------------------------*/++unsigned long num_InvExpon (int E, unsigned long Z)+/*+ * Compute the inverse of Z modulo M = 2^E by exponentiation+ */+{+   int j;+   unsigned long res = Z;++   if (Z == 0) return 0;+   if (!(Z & 1)) {+      fprintf (stderr,+      "ERROR in num_InvExpon: inverse does not exist:  E = %d, Z = %ld\n",+         E, Z);+      return 0;+   }+   for (j = 1; j <= E - 3; j++)+      res = res * res * Z;+   return res & bitset_MASK[E];+}+++/*------------------------------------------------------------------------*/++long num_RoundL (double x)+{+  return (x >= 0) ? (long)(x + 0.5) : (long)(x - 0.5);+}+++double num_RoundD (double x)+{+   double z;+   (x >= 0) ? modf(x + 0.5, &z) : modf(x - 0.5, &z);+   return z;+}+++/*------------------------------------------------------------------------*/
+ cbits/testu/src/num2.c view
@@ -0,0 +1,668 @@+/*************************************************************************\+ *+ * Package:        MyLib+ * File:           num2.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "num2.h"+#include "util.h"+#include "num.h"+#include <math.h>+#include <float.h>+#include <stdlib.h>++#define EPSILON  1.0E-15+#define MAXI 50++/* The factorials n! from n = 0 to n = 170 */+static double Factorials[] = {+   1,+   1,+   2,+   6,+   24,+   120,+   720,+   5040,+   40320,+   362880,+   3628800,+   39916800,+   479001600,+   6227020800.0,+   87178291200.0,+   1307674368000.0,+   20922789888000.0,+   355687428096000.0,+   6402373705728000.0,+   1.21645100408832e+17,+   2.43290200817664e+18,+   5.109094217170944e+19,+   1.124000727777608e+21,+   2.585201673888498e+22,+   6.204484017332394e+23,+   1.551121004333099e+25,+   4.032914611266057e+26,+   1.088886945041835e+28,+   3.048883446117138e+29,+   8.841761993739701e+30,+   2.65252859812191e+32,+   8.222838654177922e+33,+   2.631308369336935e+35,+   8.683317618811886e+36,+   2.952327990396041e+38,+   1.033314796638614e+40,+   3.719933267899012e+41,+   1.376375309122634e+43,+   5.23022617466601e+44,+   2.039788208119744e+46,+   8.159152832478977e+47,+   3.34525266131638e+49,+   1.40500611775288e+51,+   6.041526306337383e+52,+   2.658271574788449e+54,+   1.196222208654802e+56,+   5.502622159812088e+57,+   2.586232415111682e+59,+   1.241391559253607e+61,+   6.082818640342675e+62,+   3.041409320171338e+64,+   1.551118753287382e+66,+   8.065817517094388e+67,+   4.274883284060025e+69,+   2.308436973392414e+71,+   1.269640335365828e+73,+   7.109985878048635e+74,+   4.052691950487722e+76,+   2.350561331282879e+78,+   1.386831185456899e+80,+   8.320987112741392e+81,+   5.075802138772248e+83,+   3.146997326038794e+85,+   1.98260831540444e+87,+   1.268869321858842e+89,+   8.247650592082472e+90,+   5.443449390774431e+92,+   3.647111091818868e+94,+   2.480035542436831e+96,+   1.711224524281413e+98,+   1.197857166996989e+100,+   8.504785885678622e+101,+   6.123445837688608e+103,+   4.470115461512683e+105,+   3.307885441519386e+107,+   2.480914081139539e+109,+   1.88549470166605e+111,+   1.451830920282858e+113,+   1.132428117820629e+115,+   8.946182130782973e+116,+   7.156945704626378e+118,+   5.797126020747366e+120,+   4.75364333701284e+122,+   3.945523969720657e+124,+   3.314240134565352e+126,+   2.817104114380549e+128,+   2.422709538367272e+130,+   2.107757298379527e+132,+   1.854826422573984e+134,+   1.650795516090845e+136,+   1.485715964481761e+138,+   1.352001527678402e+140,+   1.24384140546413e+142,+   1.156772507081641e+144,+   1.087366156656742e+146,+   1.032997848823905e+148,+   9.916779348709491e+149,+   9.619275968248206e+151,+   9.426890448883242e+153,+   9.33262154439441e+155,+   9.33262154439441e+157,+   9.425947759838354e+159,+   9.614466715035121e+161,+   9.902900716486175e+163,+   1.029901674514562e+166,+   1.08139675824029e+168,+   1.146280563734708e+170,+   1.226520203196137e+172,+   1.324641819451828e+174,+   1.443859583202493e+176,+   1.588245541522742e+178,+   1.762952551090244e+180,+   1.974506857221073e+182,+   2.231192748659812e+184,+   2.543559733472186e+186,+   2.925093693493014e+188,+   3.393108684451897e+190,+   3.969937160808719e+192,+   4.684525849754288e+194,+   5.574585761207603e+196,+   6.689502913449124e+198,+   8.09429852527344e+200,+   9.875044200833598e+202,+   1.214630436702532e+205,+   1.50614174151114e+207,+   1.882677176888925e+209,+   2.372173242880046e+211,+   3.012660018457658e+213,+   3.856204823625803e+215,+   4.974504222477285e+217,+   6.466855489220472e+219,+   8.471580690878817e+221,+   1.118248651196004e+224,+   1.487270706090685e+226,+   1.992942746161518e+228,+   2.69047270731805e+230,+   3.659042881952547e+232,+   5.01288874827499e+234,+   6.917786472619486e+236,+   9.615723196941086e+238,+   1.346201247571752e+241,+   1.89814375907617e+243,+   2.695364137888161e+245,+   3.854370717180071e+247,+   5.550293832739301e+249,+   8.047926057471987e+251,+   1.17499720439091e+254,+   1.727245890454638e+256,+   2.556323917872864e+258,+   3.808922637630567e+260,+   5.71338395644585e+262,+   8.627209774233235e+264,+   1.311335885683452e+267,+   2.006343905095681e+269,+   3.089769613847349e+271,+   4.789142901463391e+273,+   7.471062926282891e+275,+   1.172956879426414e+278,+   1.853271869493734e+280,+   2.946702272495037e+282,+   4.714723635992059e+284,+   7.590705053947215e+286,+   1.229694218739449e+289,+   2.004401576545302e+291,+   3.287218585534294e+293,+   5.423910666131586e+295,+   9.003691705778433e+297,+   1.503616514864998e+300,+   2.526075744973197e+302,+   4.269068009004703e+304,+   7.257415615307994e+306+};+++#define MLIM 50++/* The natural logarithm of factorials n! from n = 0 to 50 */+static double LnFactorials[MLIM + 1] = {+   0.,+   0.,+   0.6931471805599453,+   1.791759469228055,+   3.178053830347946,+   4.787491742782046,+   6.579251212010101,+   8.525161361065415,+   10.60460290274525,+   12.80182748008147,+   15.10441257307552,+   17.50230784587389,+   19.98721449566188,+   22.55216385312342,+   25.19122118273868,+   27.89927138384088,+   30.67186010608066,+   33.50507345013688,+   36.39544520803305,+   39.33988418719949,+   42.33561646075348,+   45.3801388984769,+   48.47118135183522,+   51.60667556776437,+   54.7847293981123,+   58.00360522298051,+   61.26170176100199,+   64.55753862700632,+   67.88974313718154,+   71.257038967168,+   74.65823634883016,+   78.09222355331529,+   81.55795945611503,+   85.05446701758153,+   88.58082754219767,+   92.13617560368708,+   95.7196945421432,+   99.3306124547874,+   102.9681986145138,+   106.6317602606434,+   110.3206397147574,+   114.0342117814617,+   117.7718813997451,+   121.5330815154386,+   125.3172711493569,+   129.1239336391272,+   132.9525750356163,+   136.8027226373264,+   140.6739236482343,+   144.5657439463449,+   148.477766951773+};+++/*=========================================================================*/++double num2_Factorial (int n)+{+   util_Assert (n >= 0, "num2_Factorial:   n < 0");+   if (n <= 170)+      return Factorials[n];+   util_Warning (1, "num2_Factorial:   n > 170:   return inf");+   return 1.0 / 0.0;+}+++/*=========================================================================*/++double num2_LnFactorial (int n)+{+   util_Assert (n >= 0, "num2_LnFactorial:   n < 0");+   if (n <= MLIM) {+      return LnFactorials[n];++   } else {+      double x = (double) (n + 1);+      double y = 1.0 / (x * x);+      double z = ((-(5.95238095238E-4 * y) + 7.936500793651E-4) * y -+         2.7777777777778E-3) * y + 8.3333333333333E-2;+      z = ((x - 0.5) * log (x) - x) + 9.1893853320467E-1 + z / x;+      return z;+   }+}+++/*=========================================================================*/+#ifndef HAVE_LGAMMA++/* The new standard ISO_C99 includes the lgamma function in math.h;+   otherwise, we shall have to use our own. */++double num2_LnGamma (double x)+{+   const double xlimbig = 1.0 / DBL_EPSILON;+   const double xlim1 = 18.0;+   const double dk2 = 0.91893853320467274178; /* Ln (sqrt (2 Pi)) */+   const double dk1 = 0.9574186990510627;+   const int N = 15;              /* Degree of Chebyshev polynomial */+   double y = 0, z = 0;+   int i, k;++   /* Chebyshev coefficients for lnGamma (x + 3), 0 <= x <= 1 In Yudell Luke:+      The special functions and their approximations, Vol. II, Academic Press,+      p. 301, 1969. There is an error in the additive constant in the formula:+      (Ln (2)). */+   static const double A[] = {+      0.52854303698223459887,+      0.54987644612141411418,+      0.02073980061613665136,+      -0.00056916770421543842,+      0.00002324587210400169,+      -0.00000113060758570393,+      0.00000006065653098948,+      -0.00000000346284357770,+      0.00000000020624998806,+      -0.00000000001266351116,+      0.00000000000079531007,+      -0.00000000000005082077,+      0.00000000000000329187,+      -0.00000000000000021556,+      0.00000000000000001424,+      -0.00000000000000000095+   };++   util_Assert (x > 0.0, "num2_LnGamma:   accepts only x > 0");+   if (x > xlim1) {+      if (x > xlimbig)+         y = 0.0;+      else+         y = 1.0 / (x * x);+      z = ((-(5.95238095238E-4 * y) + 7.936500793651E-4) * y -+         2.7777777777778E-3) * y + 8.3333333333333E-2;+      z = ((x - 0.5) * log (x) - x) + dk2 + z / x;+      return z;++   } else if (x > 4.0) {+      k = (int) x;+      z = x - k;+      y = 1.0;+      for (i = 3; i < k; i++)+         y *= z + i;+      y = log (y);++   } else if (x <= 0.0) {+      return DBL_MAX;++   } else if (x < 3.0) {+      k = (int) x;+      z = x - k;+      y = 1.0;+      for (i = 2; i >= k; i--)+         y *= z + i;+      y = -log (y);++   } else {                       /* 3 <= x <= 4 */+      z = x - 3.0;+      y = 0.0;+   }++   z = num2_EvalCheby (A, N, 2.0 * z - 1.0);+   return z + dk1 + y;+}++#endif+/*=========================================================================*/++#define NLIM 100                  /* pour eviter les debordements */++double num2_Combination (int n, int s)+{+   double Res;+   int i;+   int Diff;+   if (s == 0 || s == n)+      return 1.0;+   if (s < 0) {+      util_Warning (1, "num2_Combination:   s < 0");+      return 0.0;+   }+   if (s > n) {+      util_Warning (1, "num2_Combination:   s > n");+      return 0.0;+   }+   if (s > (n / 2))+      s = n - s;+   if (n <= NLIM) {+      Res = 1.0;+      Diff = n - s;+      for (i = 1; i <= s; i++) {+         Res = (Res * (double) (Diff + i)) / (double) (i);+      }+      return Res;+   } else {+      Res = (num2_LnFactorial (n) - num2_LnFactorial (s))+         - num2_LnFactorial (n - s);+      return exp (Res);+   }+}+++/*=========================================================================*/+#ifndef HAVE_LOG1P++double num2_log1p (double x)+{+   /* returns a value equivalent to log (1 + x) accurate also for small x. */+   if (fabs (x) > 0.1) {+      return log (1.0 + x);+   } else {+      double term = x;+      double sum = x;+      int s = 2;+      while (fabs (term) > EPSILON * fabs (sum) && s < MAXI) {+         term *= -x;+         sum += term / s;+         s++;+      }+      return sum;+   }+}++#endif+/*=========================================================================*/++void num2_CalcMatStirling (double ***M, int m, int n)+/* Calcul des elements de la matrice MatStirling [0..m, 0..n]. */+{+   int i, j, k;+   *M = (double **) util_Calloc ((size_t) (m + 1), sizeof (double *));+   for (i = 0; i <= m; i++)+      (*M)[i] = (double *) util_Calloc ((size_t) (n + 1), sizeof (double));++   for (i = 0; i <= m; i++) {+      for (j = 0; j <= n; j++) {+         (*M)[i][j] = 0.0;+      }+   }++   (*M)[0][0] = 1.0;+   for (j = 1; j <= n; j++) {+      (*M)[0][j] = 0.0;+      if (j <= m) {+         k = j - 1;+         (*M)[j][j] = 1.0;+      } else+         k = m;+      for (i = 1; i <= k; i++) {+         (*M)[i][j] = (double) (i) * (*M)[i][j - 1] + (*M)[i - 1][j - 1];+      }+   }+}+++/*=========================================================================*/++void num2_FreeMatStirling (double ***M, int m)+{+   int i;+   for (i = 0; i <= m; i++)+      free ((*M)[i]);+   free (*M);+   *M = NULL;+}+++/*=========================================================================*/++double num2_VolumeSphere (double pLR, int k)+/* Returns volume of unit sphere in dimension k, norm p */+{+   const double eps = 2.0 * DBL_EPSILON;+   int p = pLR;+   double kLR = (double) k;+   double Vol;+   int s;++   util_Assert (pLR >= 0.0, "num2_VolumeSphere:   p < 0");+   if (fabs (pLR - p) <= eps) {+      switch (p) {+      case 0:+         return num_TwoExp[k];+         break;+      case 1:+         return num_TwoExp[k] / num2_Factorial (k);+         break;+      case 2:+         if ((k % 2) == 0) {+            return pow (num_Pi, kLR / 2.0) / num2_Factorial (k / 2);+         } else {+            s = (k + 1) / 2;+            return pow (num_Pi, (double) (s) - 1.0) * num2_Factorial (s) *+               num_TwoExp[2 * s] / num2_Factorial (2 * s);+         }+         break;+      default:+         break;+      }+   }+   Vol = kLR * (num_Ln2 + num2_LnGamma (1.0 + 1.0 / pLR)) -+      num2_LnGamma (1.0 + kLR / pLR);+   return exp (Vol);+}+++/*=========================================================================*/++double num2_EvalCheby (const double A[], int N, double x)+{+   int j;+   double xx;+   double b0, b1, b2;+   util_Warning (fabs (x) > 1.0,+      "Chebychev polynomial evaluated at x outside [-1, 1]");+   xx = 2.0 * x;+   b0 = 0.0;+   b1 = 0.0;+   for (j = N; j >= 0; j--) {+      b2 = b1;+      b1 = b0;+      b0 = (xx * b1 - b2) + A[j];+   }+   return (b0 - b2) / 2.0;+}+++/*=========================================================================*/+#define DEGREE 6++double num2_BesselK025 (double x)+{+   double rac;+   double xx;+   double temp;+   double Res;+   double C;+   double B;+   int j;+   static const double c[8] = {+      32177591145.0,+      2099336339520.0,+      16281990144000.0,+      34611957596160.0,+      26640289628160.0,+      7901666082816.0,+      755914244096.0+   };++   static const double b[8] = {+      75293843625.0,+      2891283595200.0,+      18691126272000.0,+      36807140966400.0,+      27348959232000.0,+      7972533043200.0,+      755914244096.0+   };++   if (x < 1.E-300)+      return DBL_MAX;++   /*------------------------------------------------------------------*/+   /* x > 0.6 => approximation asymptotique rationnelle dans Luke: */+   /* Yudell L.Luke "Mathematical functions and their approximations", */+   /* Academic Press Inc. New York, 1975, p.371 */+   /*------------------------------------------------------------------*/+   if (x >= 0.6) {+      B = b[DEGREE];+      C = c[DEGREE];+      for (j = DEGREE; j >= 1; j--) {+         B = B * x + b[j - 1];+         C = C * x + c[j - 1];+      }+      Res = sqrt (num_Pi / (2.0 * x)) * exp (-x) * (C / B);+      return Res;+   }++   /*------------------------------------------------------------------*/+   /* x < 0.6 => la serie de K_{1/4} = Pi/Sqrt(2) [I_{-1/4} - I_{1/4}] */+   /*------------------------------------------------------------------*/+   xx = x * x;+   rac = pow (x / 2.0, 0.25);+   Res = (((xx / 1386.0 + 1.0 / 42.0) * xx + 1.0 / 3.0) * xx + 1.0) /+      (1.225416702465177 * rac);+   temp = (((xx / 3510.0 + 1.0 / 90.0) * xx + 0.2) * xx + 1.0) * rac /+      0.906402477055477;+   Res = num_Pi * (Res - temp) / num_Rac2;+   return Res;+}++#undef DEGREE+/*=========================================================================*/++double num2_Digamma (double x)+{+   static const double C7[] = {+      1.3524999667726346383e4, 4.5285601699547289655e4,+      4.5135168469736662555e4, 1.8529011818582610168e4,+      3.3291525149406935532e3, 2.4068032474357201831e2,+      5.1577892000139084710, 6.2283506918984745826e-3+   };++   static const double D7[] = {+      6.9389111753763444376e-7, 1.9768574263046736421e4,+      4.1255160835353832333e4, 2.9390287119932681918e4,+      9.0819666074855170271e3, 1.2447477785670856039e3,+      6.7429129516378593773e1, 1.0+   };++   static const double C4[] = {+      -2.728175751315296783e-15, -6.481571237661965099e-1,+      -4.486165439180193579, -7.016772277667586642, -2.129404451310105168+   };++   static const double D4[] = {+      7.777885485229616042, 5.461177381032150702e1,+      8.929207004818613702e1, 3.227034937911433614e1, 1.0+   };++   double prodPj = 0.0;+   double prodQj = 0.0;+   double digX = 0.0;++   if (x >= 3.0) {+      double x2 = 1.0 / (x * x);+      int j;+      for (j = 4; j >= 0; j--) {+         prodPj = prodPj * x2 + C4[j];+         prodQj = prodQj * x2 + D4[j];+      }+      digX = log (x) - (0.5 / x) + (prodPj / prodQj);++   } else if (x >= 0.5) {+      const double X0 = 1.46163214496836234126;+      int j;+      for (j = 7; j >= 0; j--) {+         prodPj = x * prodPj + C7[j];+         prodQj = x * prodQj + D7[j];+      }+      digX = (x - X0) * (prodPj / prodQj);++   } else {+      double f = (1.0 - x) - floor (1.0 - x);+      digX = num2_Digamma (1.0 - x) + num_Pi / tan (num_Pi * f);+   }++   return digX;+}+
+ cbits/testu/src/scomp.c view
@@ -0,0 +1,642 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           scomp.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "chrono.h"+#include "num.h"+#include "tables.h"++#include "scomp.h"+#include "sres.h"+#include "swrite.h"+#include "unif01.h"++#include "fbar.h"+#include "wdist.h"+#include "gofw.h"+#include "gofs.h"+#include "statcoll.h"++#include <math.h>+#include <float.h>+#include <stdlib.h>+++#define LENGTH 100++/* Empirical Mean for Lempel-Ziv test for 2^3 <= n <= 2^28. Obtained by+   simulation with N = 1000  */+static const double LZMu[] = {+   0.0,   0.0,   0.0,   4.44,   7.64,+   12.5,   20.8,   34.8,   58.9,   101.1,+   176.0,   310.0,   551.9,   992.3,   1799.,+   3286.2,   6041.5,   11171.5,   20761.8,   38760.4,+   72654.,   136677.,   257949.,   488257.,   926658.,+   1762965.,   3361490.,   6422497.,   12293930.+};++/* Empirical Standard Deviation for Lempel-Ziv test for 2^3 <= n <= 2^28 */+static const double LZSigma[] = {+   0.0,   0.0,   0.0,   0.49,   0.51,+   0.62,   0.75,   0.78,   0.86,   0.94,+   1.03,   1.19,   1.43,   1.68,   2.09,+   2.46,   3.36,   4.2,   5.4,   6.8,+   9.1,   10.9,   14.7,   19.1,   25.2,+   33.5,   44.546,   58.194,   75.513+};++++/*--------------------------------- Types ---------------------------------*/++/* Bit trie used in Lempel-Ziv test. If left != NULL, this means a 0 bit.+   If right != NULL, this means a 1 bit. The word is the sequence obtained+   by following the tree until a NULL pointer is met. */+   +struct BitTrie_t {+   struct BitTrie_t *left;+   struct BitTrie_t *right;+};+typedef struct BitTrie_t BitTrie_t;+++++/*-------------------------------- Functions ------------------------------*/++static void DeleteBitTrie (BitTrie_t *tree)+{+   if (tree == NULL)+      return;+   DeleteBitTrie (tree->left);+   DeleteBitTrie (tree->right);+   util_Free (tree);+}+++/*=========================================================================*/+++static void InitRes (+   scomp_Res *res,            /* Results holder */+   long N,                    /* Number of replications */+   int jmax,                  /* Max class index for size of jumps */+   int tmax                   /* Max class index for linear complexity */+)+/* + * Initializes the scomp_Res structure+ */+{+   sres_InitBasic (res->JumpNum, N,+      "scomp_LinearComp:   Number of Jumps");+   sres_InitChi2 (res->JumpSize, N, jmax,+      "scomp_LinearComp:   Size of Jumps");+   sres_InitChi2 (res->LinComp, N, tmax,+      "scomp_LinearComp:   Linear Complexity");+}+++/*-------------------------------------------------------------------------*/++scomp_Res * scomp_CreateRes (void)+{+   scomp_Res *res;+   res = util_Malloc (sizeof (scomp_Res));+   res->JumpNum = sres_CreateBasic ();+   res->JumpSize = sres_CreateChi2 ();+   res->LinComp = sres_CreateChi2 ();+   return res;+}+++/*-------------------------------------------------------------------------*/++void scomp_DeleteRes (scomp_Res *res)+{+   if (res == NULL)+      return;+   sres_DeleteBasic (res->JumpNum);+   sres_DeleteChi2 (res->JumpSize);+   sres_DeleteChi2 (res->LinComp);+   util_Free (res);+}+++/*=========================================================================*/++static void WriteDataJumps (unif01_Gen *gen, char *TestName, long N, long n,+   int r, int s, double muComp, double mu, double sigma)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",    s = %1d\n", s);+   if (swrite_Parameters) {+      printf ("\n      muComp = ");+      num_WriteD (muComp, 12, 4, 2);+      printf ("\n      Mu     = ");+      num_WriteD (mu, 12, 4, 2);+      printf ("\n      Sigma  = ");+      num_WriteD (sigma, 12, 4, 2);+   }+   printf ("\n\n");+}+++/*-------------------------------------------------------------------------*/++static void BerlekampMassey (+   scomp_Res *res,+   long n,                  /* Number of bits */+   double *pComp,           /* Linear complexity */+   double *pNumJ,           /* Number of jumps */+   int *Bits,+   int *Polyb,+   int *Polyc,+   int *PolycOld+   )+/*+ * Berlekamp-Massey algorithm to calculate the linear complexity.+ */+{+   int b;+   long Loc;+   long i;+   long m;+   long k;+   long L;                  /* Linear complexity */+   long NumJ;               /* Number of jumps */+   sres_Chi2 *resl = res->JumpSize;++   for (k = 0; k <= resl->jmax; k++)+      resl->Count[k] = 0;++   Polyc[0] = 1;+   Polyb[0] = 1;+   L = 0;+   NumJ = 0;+   k = 0;+   m = -1;++   while (k < n) {+      /* Return the value of the current polynomial to see if it can+         generate the next bit */+      b = 0;+      for (i = 1; i <= L; i++)+         /* b ^= Polyc[i] * Bits[k + 1 - i]; */+         b = (b + Polyc[i] * Bits[k + 1 - i]) & 1;++      if (Bits[k + 1] != b) {+         /* Update c(x)_old and c(x) */+         for (i = 0; i <= L; i++)+            PolycOld[i] = Polyc[i];++         for (i = 0; i <= L; i++) {+            if (Polyb[i] == 1)+               Polyc[k - m + i] = (++Polyc[k - m + i]) & 1;+         }+         if (2 * L <= k) {+            L = k + 1 - L;+            NumJ++;+            Loc = labs (k + 1 - 2 * L);+            if (Loc <= resl->jmax)+               ++resl->Count[Loc];+            else+               ++resl->Count[resl->jmax];+            /* Update B */+            for (i = 0; i <= L; i++)+               Polyb[i] = PolycOld[i];+            m = k;+         }+      }+      ++k;+   }+   *pNumJ = NumJ;+   *pComp = L;+}+++/*=========================================================================*/++void scomp_LinearComp (unif01_Gen *gen, scomp_Res *res,+                       long N, long n, int r, int s)+{+   const double epsilon = 1.0E-10;+   const int tt = 1 - 0.5 * num_Log2 (3 * epsilon); /* Dimension */+   const long K0 = n/s;+   long i, Seq;+   int j, k;+   int M0;+   double NumJ;                   /* Number of Jumps */+   double sigma, mu;              /* Parameters of number of jumps */+   double comp;                   /* Linear complexity */+   double muComp;                 /* Mean of linear complexity */+   unsigned long Nombre;          /* Random number */+   int Parite;+   double *Prob;+   long *Loca;+   long tmin, tmax, NbClasses;+   double X2;+   double temp;+   int *Bits;                     /* 4 Arrays of bits */+   int *Polyb;+   int *Polyc;+   int *PolycOld;+   double Param[1];+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "scomp_LinearComp test";+   sres_Basic *resJN;+   sres_Chi2 *resJL;+   sres_Chi2 *resLC;+   lebool JL_OK = TRUE;          /* If TRUE do the JL test, otherwise not */+   lebool LC_OK = FALSE;         /* If TRUE do the LC test, otherwise not */++   Timer = chrono_Create ();+   n = K0 * s;+   Parite = n & 1;+   if (n >= DBL_MAX_EXP)+      temp = 0.0;+   else+      temp = pow (2.0, -(double) n);++   mu = n / 4.0 + (4 + Parite) / 12.0 - temp / 3.0;+   sigma = n / 8.0 - (2 - Parite)/(9.0 - Parite) + n * temp / 6.0+           + (6 + Parite) * temp / 18.0 - temp * temp / 9.0;+   sigma = sqrt (sigma);+   muComp = n / 2.0 + (4 + Parite) / 18.0;+   M0 = num_Log2 (mu / gofs_MinExpected);+   if (M0 < 2) {+      /* 0 degree of freedom for the chi2, do not do the test JL. */+      JL_OK = FALSE;+   }++   if (swrite_Basic)+      WriteDataJumps (gen, TestName, N, n, r, s, muComp, mu, sigma);++   /* util_Assert (M0 > 1, "scomp_LinearComp:   n*s is too small"); */+   util_Assert (M0 <= num_MaxTwoExp, "scomp_LinearComp:   M0 > num_MaxTwoExp");++   Prob = util_Calloc (1 + (size_t) tt, sizeof (double));+   Bits = util_Calloc ((size_t) n + 1, sizeof (int));+   Polyb = util_Calloc ((size_t) n + 1, sizeof (int));+   Polyc = util_Calloc ((size_t) n + 1, sizeof (int));+   PolycOld = util_Calloc ((size_t) n + 1, sizeof (int));++   if (res == NULL) {+      localRes = TRUE;+      res = scomp_CreateRes ();+   }+   M0 = util_Max (M0, 1);+   InitRes (res, N, M0, tt);+   resJN = res->JumpNum;+   resJL = res->JumpSize;+   resLC = res->LinComp;+   Loca = resLC->Loc;++   if (N > 2.0 * gofs_MinExpected) {+      /* Compute the expected probabilities for the linear complexity. */+      /* We put in Prob[k] the probabilities for i = k and i = -k of   */+      /* the statistic defined in the NIST document 800-22, p. 86. */+      temp = Prob[0] = 0.5;+      for (k = 1; k < tt; k++) {+	 Prob[k] = 1.5 * pow (4.0, -(double) k);+	 temp += Prob[k];+      }+      Prob[tt] = 1.0 - temp;+      for (k = 0; k <= tt; k++) {+	 resLC->Count[k] = 0;+	 resLC->NbExp[k] = N * Prob[k];+      }+      tmin = 0;+      tmax = tt;+      if (swrite_Classes) {+	 printf ("Classes for the linear complexity:\n");+	 gofs_WriteClasses (resLC->NbExp, Loca, tmin, tmax, 0);+      }+      gofs_MergeClasses (resLC->NbExp, Loca, &tmin, &tmax, &NbClasses);+      resLC->jmax = tmax;+      resLC->jmin = tmin;+      resLC->degFree = NbClasses - 1;+      if (NbClasses < 2) {+	 /* 0 degree of freedom for the chi2, do not do the test LC. */+	 LC_OK = FALSE;+      } else+	 LC_OK = TRUE;+   }++   statcoll_SetDesc (resJN->sVal1,+      "The number of jumps: the N statistic values (a standard normal):");+   sprintf (str, "The jumps size: the N statistic values (a ChiSquare"+                 " with %1d degrees of freedom):", M0 - 1);+   statcoll_SetDesc (resJL->sVal1, str);++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = 0; i < K0; i++) {+         Nombre = unif01_StripB (gen, r, s);+         for (j = s; j >= 1; j--) {+            Bits[s * i + j] = Nombre & 1;+            Nombre >>= 1;+         }+      }++      BerlekampMassey (res, n, &comp, &NumJ, Bits, Polyb, Polyc, PolycOld);++      /* Value of the statistic for the linear complexity */+      if (LC_OK) {+	 comp = comp - muComp;+	 if (Parite)+	    comp = -comp;+	 comp += 2.0 / 9.0;+         /* comp is now an integer: truncate correctly and avoid off-by-1+            error because of small floating-point inaccuracies. */+	 if (comp >= 0.0)+	    k = comp + 0.5;+	 else+	    k = comp - 0.5;+	 if (k < 0)+	    k = -k;+	 if (k >= tt)+	    ++resLC->Count[Loca[tt]];+	 else+	    ++resLC->Count[Loca[k]];+      }++      /* Value of the normal statistic for the number of jumps */+      statcoll_AddObs (resJN->sVal1, (NumJ - mu) / sigma);++      /* Value of the statistic for the size of the jumps */+      if (JL_OK) {+	 for (k = 1; k < M0; k++) {+	    resJL->NbExp[k] = NumJ / num_TwoExp[k];+	    resJL->Loc[k] = k;+	 }+	 resJL->NbExp[M0] = NumJ / num_TwoExp[M0 - 1];+	 resJL->Loc[M0] = M0;+	 resJL->jmax = M0;+	 resJL->jmin = 1;+	 resJL->degFree = M0 - 1;++	 X2 = gofs_Chi2 (resJL->NbExp, resJL->Count, 1, M0);+	 statcoll_AddObs (resJL->sVal1, X2);+	 if (swrite_Classes) {+	    printf ("\n\nClasses for the size of the jumps:\n");+	    gofs_WriteClasses (resJL->NbExp, (long *) NULL, 1, M0, 0);+	 }+         if (swrite_Counters)+            tables_WriteTabL (resJL->Count, 1, M0, 5, 10,+                "Size of the jumps:   observed numbers");+      }+   }++   gofw_ActiveTests2 (resJN->sVal1->V, resJN->pVal1->V, N, wdist_Normal,+      (double *) NULL, resJN->sVal2, resJN->pVal2);+   resJN->pVal1->NObs = N;+   sres_GetNormalSumStat (resJN);++   if (JL_OK) {+      Param[0] = M0 - 1;+      gofw_ActiveTests2 (resJL->sVal1->V, resJL->pVal1->V, N, +         wdist_ChiSquare, Param, resJL->sVal2, resJL->pVal2);+      resJL->pVal1->NObs = N;+      sres_GetChi2SumStat (resJL);+   }++   if (LC_OK) {+      X2 = gofs_Chi2 (resLC->NbExp, resLC->Count, tmin, tmax);+      resLC->sVal2[gofw_Mean] = X2;+      resLC->pVal2[gofw_Mean] = fbar_ChiSquare2 (NbClasses - 1, 8, X2);+   }++   if (swrite_Basic) {+      if (JL_OK) {+	 printf ("\n-----------------------------------------------\n");+	 if (N == 1) {+            printf ("Number of degrees of freedom          : %4ld\n",+                    resJL->degFree);+	    printf ("Chi2 statistic for size of jumps      :");+	    gofw_Writep2 (resJL->sVal2[gofw_Mean], resJL->pVal2[gofw_Mean]);+	 } else {+	    printf ("Test results for the size of jumps:\n");+	    gofw_WriteActiveTests0 (N, resJL->sVal2, resJL->pVal2);+            swrite_Chi2SumTest (N, resJL);+	 }+	 if (swrite_Collectors)+	    statcoll_Write (resJL->sVal1, 5, 14, 4, 3);+      }++      printf ("\n-----------------------------------------------\n");+      if (N == 1) {+         printf ("Normal statistic for number of jumps  :");+         gofw_Writep2 (resJN->sVal2[gofw_Mean], resJN->pVal2[gofw_Mean]);+      } else {+         printf ("Test results for the number of jumps:\n");+         gofw_WriteActiveTests0 (N, resJN->sVal2, resJN->pVal2);+         swrite_NormalSumTest (N, resJN);+      }+      if (swrite_Collectors)+         statcoll_Write (resJN->sVal1, 5, 14, 4, 3);++      if (LC_OK) {+         printf ("\n-----------------------------------------------\n");+         printf ("Test results for the linear complexity:\n\n");+         printf ("Number of degrees of freedom          : %4ld\n",+                 resLC->degFree);+         printf ("Chi2 statistic on the N replications  :");+         gofw_Writep2 (resLC->sVal2[gofw_Mean], resLC->pVal2[gofw_Mean]);+         if (swrite_Classes)+	    gofs_WriteClasses (resLC->NbExp, Loca, tmin, tmax, NbClasses);+         if (swrite_Counters)+            tables_WriteTabL (resLC->Count, tmin, tmax, 5, 10,+               "Linear Complexity:   observed numbers");+      }++      printf ("\n\n");+      swrite_Final (gen, Timer);+   }++   util_Free (Prob);+   util_Free (Bits);+   util_Free (Polyb);+   util_Free (Polyc);+   util_Free (PolycOld);+   if (localRes)+      scomp_DeleteRes (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataLZ (+   unif01_Gen *gen,      /* generator */+   char *Test,           /* Test name */+   long N,               /* Number of replications */+   int k,                /* Sample size n = 2^k */+   int r,                /* r first bits of each random number dropped */+   int s                 /* s bits of each random number used */+)+{+   long n;+   n = num_TwoExp[k];+   swrite_Head (gen, Test, N, n, r);+   printf (",   s = %4d,   k = %4d\n\n", s, k);+}+++/*-------------------------------------------------------------------------*/++static long LZ78 (unif01_Gen * gen, long n, int r, int s)+/*+ * The parameters are the same as in scomp_LempelZiv. The trie contains+ * a left (right) branch if a word with a 0 (1) bit after the prefix has+ * been seen before. We descend one level in the trie with each bit until+ * a leaf is met. Add a branch for a new word, and restart at root.+ */+{+   const unsigned long kMAX = 1UL << (s - 1);+   unsigned long Y, k;+   long i;                        /* Count the number of bits overall */+   long W;                        /* Count the number of words */+   lebool done = FALSE;          /* Start a new word */+   BitTrie_t *trie, *root;++   W = i = 0;+   trie = root = util_Malloc (sizeof (BitTrie_t));+   trie->left = trie->right = NULL;+   Y = unif01_StripB (gen, r, s);+   k = kMAX;++   while (i < n) {+      /* Start a new word: match it as far as possible in the trie */+      done = FALSE;+      trie = root;+      while (!done) {+         if ((Y & k) == 0) {      /* Bit 0 */+            if (trie->left) {+	       /* We have seen it before: descend in branch */+               trie = trie->left;+            } else {+	       /* A leaf: this is a new word */+               W++;+               done = TRUE;+               trie->left = util_Malloc (sizeof (BitTrie_t));+               trie = trie->left;+               trie->left = trie->right = NULL;+            }++         } else {                 /* Bit 1 */+            if (trie->right) {+               trie = trie->right;+            } else {+               W++;+               done = TRUE;+               trie->right = util_Malloc (sizeof (BitTrie_t));+               trie = trie->right;+               trie->left = trie->right = NULL;+            }+         }+         i++;+         if (i >= n) {+            done = TRUE;+            if ((trie->left != NULL) || (trie->right != NULL))+               W++;+            break;+	 }+         k >>= 1;+         if (k == 0) {+	    /* Have used the s bits in the number; generate a new number */+            Y = unif01_StripB (gen, r, s);+            k = kMAX;+         }+      }+   }+   DeleteBitTrie (root);+   return W;+}+++/*-------------------------------------------------------------------------*/++void scomp_LempelZiv (unif01_Gen *gen, sres_Basic *res,+   long N, int t, int r, int s)+{+   long Seq, n;+   double X;+   /*   const double lg_n = num_Log2 ((double) n); */+   long W;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "scomp_LempelZiv test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataLZ (gen, TestName, N, t, r, s);+   util_Assert (r + s <= 32, "scomp_LempelZiv:   r + s > 32");+   util_Assert (t <= 28, "scomp_LempelZiv:   k > 28");+   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateBasic ();+   }+   n = num_TwoExp[t];+   sres_InitBasic (res, N, "scomp_LempelZiv");+   statcoll_SetDesc (res->sVal1, "sVal1:   a standard normal");++   for (Seq = 1; Seq <= N; Seq++) {+      W = LZ78 (gen, n, r, s);+      /*  X = (W - n / lg_n) / sqrt (0.266 * n / (lg_n * lg_n * lg_n)); */+      X = (W - LZMu[t]) / LZSigma[t];+      statcoll_AddObs (res->sVal1, X);+      if (swrite_Counters) {+         printf ("%12ld ", W);+         if (Seq % 5 == 0)+            printf ("\n");+         if (Seq >= N)+            printf ("\n\n");+      }+   }++   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Normal,+      (double *) NULL, res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetNormalSumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 12, 4, 3);++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,+         "Normal statistic                      :");+      swrite_NormalSumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteBasic (res);+   chrono_Delete (Timer);+}
+ cbits/testu/src/sknuth.c view
@@ -0,0 +1,1159 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           sknuth.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "tables.h"+#include "chrono.h"+#include "num2.h"++#include "sknuth.h"+#include "sres.h"+#include "smultin.h"+#include "wdist.h"+#include "swrite.h"+#include "unif01.h"++#include "gofs.h"+#include "gofw.h"++#include <math.h>+#include <stdio.h>+++#define LENGTH 200+++++/*-------------------------------- Functions ------------------------------*/+++static void InitRes1 (+   sknuth_Res1 *res,          /* Results holder */+   long N,                    /* Number of replications */+   int d                      /* Max class index for chi2 */+)+/* + * Initializes the sknuth_Res structure+ */+{+   sres_InitBasic (res->Bas, N, "sknuth_MaxOft:   Anderson-Darling");+   sres_InitChi2 (res->Chi, N, d, "sknuth_MaxOft:   Chi2");+}+++/*-------------------------------------------------------------------------*/++sknuth_Res1 * sknuth_CreateRes1 (void)+{+   sknuth_Res1 *res;+   res = util_Malloc (sizeof (sknuth_Res1));+   res->Bas = sres_CreateBasic ();+   res->Chi = sres_CreateChi2 ();+   return res;+}+++/*-------------------------------------------------------------------------*/++void sknuth_DeleteRes1 (sknuth_Res1 *res)+{+   if (res == NULL)+      return;+   sres_DeleteBasic (res->Bas);+   sres_DeleteChi2 (res->Chi);+   util_Free (res);+}+++/*=========================================================================*/++static void InitRes2 (+   sknuth_Res2 *res,           /* Results holder */+   long N,                     /* Number of replications */+   double Lambda,              /* Poisson mean */+   char *nam                   /* Test name */+)+/* + * Initializes res+ */+{+   sres_InitBasic (res->Bas, N, nam);+   sres_InitPoisson (res->Pois, N, Lambda, nam);+}+++/*-------------------------------------------------------------------------*/++sknuth_Res2 * sknuth_CreateRes2 (void)+{+   sknuth_Res2 *res;+   res = util_Malloc (sizeof (sknuth_Res2));+   res->Bas = sres_CreateBasic ();+   res->Pois = sres_CreatePoisson ();+   res->Pois->pLeft = -1.0;+   res->Pois->pRight = -1.0;+   return res;+}+++/*-------------------------------------------------------------------------*/++void sknuth_DeleteRes2 (sknuth_Res2 *res)+{+   if (res == NULL)+      return;+   sres_DeleteBasic (res->Bas);+   sres_DeletePoisson (res->Pois);+   util_Free (res);+}+++/*=========================================================================*/++void sknuth_Serial (unif01_Gen *gen, sres_Chi2 *res,+                    long N, long n, int r, long d, int t)+{+   double ValDelta[] = { 1.0 };+   smultin_Param *par;++   if (swrite_Basic)+      printf ("***********************************************************\n"+              "Test sknuth_Serial calling smultin_Multinomial\n\n");++   par = smultin_CreateParam (1, ValDelta, smultin_GenerCellSerial, 3);+   if (NULL == res) {+      smultin_Multinomial (gen, par, NULL, N, n, r, d, t, FALSE);+   } else {+      smultin_Res *resm;+      resm = smultin_CreateRes (par);+      smultin_Multinomial (gen, par, resm, N, n, r, d, t, FALSE);+      sres_InitChi2 (res, N, -1, "sknuth_Serial");+      statcoll_SetDesc (res->sVal1, "Serial sVal1");+      res->sVal1->NObs = resm->Collector[0]->NObs;+      tables_CopyTabD (resm->Collector[0]->V, res->sVal1->V, 1, N);+      tables_CopyTabD (resm->sVal2[0], res->sVal2, 0, gofw_NTestTypes - 1);+      tables_CopyTabD (resm->pVal2[0], res->pVal2, 0, gofw_NTestTypes - 1);+      smultin_DeleteRes (resm);+   }+   smultin_DeleteParam (par);+}+++/*=========================================================================*/++void sknuth_SerialSparse (unif01_Gen *gen, sres_Chi2 *res,+                          long N, long n, int r, long d, int t)+{+   double ValDelta[] = { 1.0 };+   smultin_Param *par;++   if (swrite_Basic)+      printf ("***********************************************************\n"+              "Test sknuth_SerialSparse calling smultin_Multinomial\n\n");++   par = smultin_CreateParam (1, ValDelta, smultin_GenerCellSerial, 3);+   if (NULL == res) {+      smultin_Multinomial (gen, par, NULL, N, n, r, d, t, TRUE);+   } else {+      smultin_Res *resm;+      resm = smultin_CreateRes (par);+      smultin_Multinomial (gen, par, resm, N, n, r, d, t, TRUE);+      sres_InitChi2 (res, N, -1, "sknuth_SerialSparse");+      statcoll_SetDesc (res->sVal1, "Serial sVal1");+      res->sVal1->NObs = resm->Collector[0]->NObs;+      tables_CopyTabD (resm->Collector[0]->V, res->sVal1->V, 1, N);+      tables_CopyTabD (resm->sVal2[0], res->sVal2, 0, gofw_NTestTypes - 1);+      tables_CopyTabD (resm->pVal2[0], res->pVal2, 0, gofw_NTestTypes - 1);+      smultin_DeleteRes (resm);+   }+   smultin_DeleteParam (par);+}+++/*=========================================================================*/++static void WriteDataGap (unif01_Gen *gen, char *TestName,+   long N, long n, int r, double Alpha, double Beta)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   Alpha = %8.6g,   Beta  = %8.6g\n\n", Alpha, Beta);+}+++/*-------------------------------------------------------------------------*/++void sknuth_Gap (unif01_Gen *gen, sres_Chi2 *res,+                 long N, long n, int r, double Alpha, double Beta)+{+   int len;+   int t;+   long m;                        /* Number of observed Gaps */+   long Seq;                      /* Current replication number */+   double p;                      /* Probability of U01 in (Alpha, Beta) */+   double X2;+   double U;+   double Mult;+   double V[1];                   /* Number of degrees of freedom for Chi2 */+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sknuth_Gap test";++   Timer = chrono_Create ();+   p = Beta - Alpha;+   t = log (gofs_MinExpected / n) / num2_log1p (-p);+   len = 1 + log (gofs_MinExpected / (n*p)) / num2_log1p (-p);+   t = util_Min(t, len);+   t = util_Max(t, 0);++   Mult = p * n;+   if (swrite_Basic)+      WriteDataGap (gen, TestName, N, n, r, Alpha, Beta);++   util_Assert (Alpha >= 0.0 && Alpha <= 1.0,+                "sknuth_Gap:   Alpha outside interval [0..1]");+   util_Assert (Beta <= 1.0 && Beta > Alpha,+                "sknuth_Gap:   Beta outside interval (Alpha..1]");++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, t, "sknuth_Gap");++   sprintf (str, "The N statistic values (a ChiSquare with %1d degrees"+                 " of freedom):", t);+   statcoll_SetDesc (res->sVal1, str);+   res->degFree = t;+   if (res->degFree < 1) {+      util_Warning (TRUE, "Chi-square with 0 degree of freedom.");+      if (localRes)+         sres_DeleteChi2 (res);+      chrono_Delete (Timer);+      return;+   }++   /* Compute the probabilities for each gap length */+   res->NbExp[0] = Mult;+   res->Loc[0] = 0;+   for (len = 1; len < t; len++) {+      Mult *= 1.0 - p;+      res->NbExp[len] = Mult;+      res->Loc[len] = len;+   }+   res->NbExp[t] = Mult * (1.0 - p) / p;+   res->Loc[t] = t;+   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, res->Count, 0, t, 0);++   /* Beginning of test */+   for (Seq = 1; Seq <= N; Seq++) {+      for (len = 0; len <= t; len++)+         res->Count[len] = 0;+      for (m = 1; m <= n; m++) {+         /* Process one gap */+         len = 0;+         U = unif01_StripD (gen, r);+         while ((U < Alpha || U >= Beta) && len < n) {+            ++len;+            U = unif01_StripD (gen, r);+         }+         if (len >= n) {+            util_Warning (TRUE,+   "sknuth_Gap:   one gap of length > n\n*********  Interrupting the test\n");+            printf ("\n\n");+            res->pVal2[gofw_Mean] = res->pVal2[gofw_AD]+                   = res->pVal2[gofw_KSM] = res->pVal2[gofw_KSP] = 0.0;+            if (localRes)+               sres_DeleteChi2 (res);+            chrono_Delete (Timer);+            return;+         }+         if (len >= t)+            ++res->Count[t];+         else+            ++res->Count[len];+      }+      if (swrite_Counters)+         tables_WriteTabL (res->Count, 0, t, 5, 10, "Observed numbers:");++      X2 = gofs_Chi2 (res->NbExp, res->Count, 0, t);+      statcoll_AddObs (res->sVal1, X2);+   }++   V[0] = t;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+                      res->sVal2, res->pVal2);+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      swrite_AddStrChi (str, LENGTH, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataPoker (unif01_Gen * gen, char *TestName,+   long N, long n, int r, int d, int k)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   d = %4d,   k = %4d\n\n", d, k);+}+++/*-------------------------------------------------------------------------*/++#define Maxkd 127++void sknuth_SimpPoker (unif01_Gen *gen, sres_Chi2 *res,+                       long N, long n, int r, int d, int k)+{+   long Seq;                      /* Replication number */+   long NbGroups;                 /* Number of classes */+   long jhigh;+   long jlow;+   long Groupe;+   long L;+   int Minkd;+   int s, j;+   double X2;+   double Mult;+   double *NbExp;+   long *Loca;+   long *Nb;+   lebool Occurs[1 + Maxkd];+   double **M;+   double V[1];                   /* Number degrees of freedom for Chi2 */+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sknuth_SimpPoker test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataPoker (gen, TestName, N, n, r, d, k);++   util_Assert (d <= Maxkd, "sknuth_SimpPoker:   d > 127");+   util_Assert (k <= Maxkd, "sknuth_SimpPoker:   k > 127");+   util_Assert (d > 1, "sknuth_SimpPoker:   d < 2");+   util_Assert (k > 1, "sknuth_SimpPoker:   k < 2");+   if (k < d)+      Minkd = k;+   else+      Minkd = d;++   num2_CalcMatStirling (&M, Minkd, k);++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, Minkd, "sknuth_SimpPoker");+   NbExp = res->NbExp;+   Nb = res->Count;+   Loca = res->Loc;++   /* NbExp[s] = n * d * (d-1) * ... * (d-s+1) * M [s,k] / d^k.  */+   Mult = n * pow ((double) d, -(double) k);+   for (s = 1; s <= Minkd; s++) {+      Mult *= d - s + 1;+      NbExp[s] = Mult * M[s][k];+   }+   jlow = 1;+   jhigh = Minkd;+   if (swrite_Classes)+      gofs_WriteClasses (NbExp, Loca, jlow, jhigh, 0);+   gofs_MergeClasses (NbExp, Loca, &jlow, &jhigh, &NbGroups);+   if (swrite_Classes)+      gofs_WriteClasses (NbExp, Loca, jlow, jhigh, NbGroups);+   res->jmin = jlow;+   res->jmax = jhigh;+   res->degFree = NbGroups - 1;+   if (res->degFree < 1) {+      if (localRes)+         sres_DeleteChi2 (res);+      return;+   }+   sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"+                 " of freedom):", NbGroups - 1);+   statcoll_SetDesc (res->sVal1, str);++   for (Seq = 1; Seq <= N; Seq++) {+      for (s = 1; s <= Minkd; s++)+         Nb[s] = 0;+      for (Groupe = 1; Groupe <= n; Groupe++) {+         /* Draw one poker hand */+         for (j = 0; j < d; j++)+            Occurs[j] = FALSE;+         s = 0;                   /* s = number of different values */+         for (j = 1; j <= k; j++) {+            L = unif01_StripL (gen, r, d);+            if (!Occurs[L]) {+               Occurs[L] = TRUE;+               ++s;+            }+         }+         ++Nb[Loca[s]];+      }+      if (swrite_Counters)+         tables_WriteTabL (Nb, jlow, jhigh, 5, 10, "Observed numbers:");++      X2 = gofs_Chi2 (NbExp, Nb, jlow, jhigh);+      statcoll_AddObs (res->sVal1, X2);+   }++   V[0] = NbGroups - 1;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors) {+      statcoll_Write (res->sVal1, 5, 14, 4, 3);+   }+   if (swrite_Basic) {+      swrite_AddStrChi (str, LENGTH, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   num2_FreeMatStirling (&M, Minkd);+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++#define MAXT 62++static void WriteDataCoupCol (unif01_Gen *gen, char *TestName,+   long N, long n, int r, int d)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   d = %4d\n\n", d);+}+++/*-------------------------------------------------------------------------*/++static long NRepet (+   unif01_Gen *gen, +   int dInt,                  /* d */+   int r,+   lebool Occurs[]+   )+/*+ * Used by CouponCollector. Counts the number of values generated before+ * each possible value of d appears at least once.+ */+{+   int u, j;+   int s = 0;++   for (j = 1; j <= dInt; j++) {+      do {+         ++s;+         if (s >= MAXT)+            return MAXT;+         u = unif01_StripL (gen, r, dInt);+      } while (Occurs[u]);+      Occurs[u] = TRUE;+   }+   /* j is the number of different values observed up to now */+   return s;+}+++/*-------------------------------------------------------------------------*/++void sknuth_CouponCollector (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, int d)+{+   long Seq;                      /* Replication number */+   long Segm;+   const int t = MAXT;+   long tt = t;+   int dInt = d;+   long dd = d;+   int s, k;+   long NbGroups;+   double Moydes;+   double Mult;+   double dReal = d;+   double **M;+   double *NbExp;+   long *Loca;+   long *Nb;+   lebool Occurs[1 + MAXT];+   double X2;+   double V[1];                   /* Number degrees of freedom for Chi2 */+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sknuth_CouponCollector test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataCoupCol (gen, TestName, N, n, r, d);++   util_Assert (d < MAXT, "sknuth_CouponCollector:  d >= 62");+   util_Assert (d > 1, "sknuth_CouponCollector:  d < 2");++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, MAXT, "sknuth_CouponCollector");+   NbExp = res->NbExp;+   Nb = res->Count;+   Loca = res->Loc;++   /* Compute the expected number of segments of each length */+   /* NbExp [s] = n * d! * Stirling (d-1, s-1) / d^s for d <= s <= t - 1 */+   /* NbExp [t] = n * (1 - d! * Stirling (d, t-1) / d^{t-1}) */+   dInt = d;+   num2_CalcMatStirling (&M, d, t - 1);+   Mult = n;+   for (s = 1; s <= d; s++) {+      Mult *= s / dReal;+   }+   NbExp[d] = Mult;+   Moydes = d * Mult;+   for (s = d + 1; s < t; s++) {+      Mult /= dReal;+      NbExp[s] = Mult * M[d - 1][s - 1];+      Moydes += s * NbExp[s];+   }+   NbExp[t] = n - Mult * M[d][t - 1];+   Moydes += t * NbExp[t];+   Moydes /= n;+ /* +   if (swrite_Basic) {+       printf ("   Expected value of s = ");+	   num_WriteD (Moydes, 10, 2, 2);+      printf ("\n\n");+   }+ */+   if (swrite_Classes)+      gofs_WriteClasses (NbExp, Loca, d, t, 0);+   gofs_MergeClasses (NbExp, Loca, &dd, &tt, &NbGroups);+   if (swrite_Classes)+      gofs_WriteClasses (NbExp, Loca, dd, tt, NbGroups);+   res->jmin = dd;+   res->jmax = tt;+   res->degFree = NbGroups - 1;+   if (res->degFree < 1) {+      if (localRes)+         sres_DeleteChi2 (res);+      return;+   }++   sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"+                 " of freedom):", NbGroups - 1);+   statcoll_SetDesc (res->sVal1, str);++   /* Beginning of test */+   for (Seq = 1; Seq <= N; Seq++) {+      for (s = dInt; s <= MAXT; s++)+         Nb[s] = 0;+      for (Segm = 1; Segm <= n; Segm++) {+         /* One collection of values. */+         for (k = 0; k < dInt; k++)+            Occurs[k] = FALSE;+         ++Nb[Loca[NRepet (gen, dInt, r, Occurs)]];+      }+      if (swrite_Counters)+         tables_WriteTabL (Nb, dd, tt, 5, 10, "Observed numbers:");++      X2 = gofs_Chi2 (NbExp, Nb, dd, tt);+      statcoll_AddObs (res->sVal1, X2);+   }++   V[0] = NbGroups - 1;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors) {+      statcoll_Write (res->sVal1, 5, 14, 4, 3);+   }+   if (swrite_Basic) {+      swrite_AddStrChi (str, LENGTH, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   num2_FreeMatStirling (&M, d);+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++void sknuth_Permutation (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, int t)+{+   double ValDelta[] = { 1.0 };+   smultin_Param *par;++   if (swrite_Basic)+      printf ("***********************************************************\n"+              "Test sknuth_Permutation calling smultin_Multinomial\n\n");++   par = smultin_CreateParam (1, ValDelta, smultin_GenerCellPermut, 3);+   if (NULL == res) {+      smultin_Multinomial (gen, par, NULL, N, n, r, 1, t, FALSE);+   } else {+      smultin_Res *resm;+      resm = smultin_CreateRes (par);+      smultin_Multinomial (gen, par, resm, N, n, r, 1, t, FALSE);+      sres_InitChi2 (res, N, -1, "sknuth_Permutation");+      statcoll_SetDesc (res->sVal1, "Serial sVal1");+      res->sVal1->NObs = resm->Collector[0]->NObs;+      tables_CopyTabD (resm->Collector[0]->V, res->sVal1->V, 1, N);+      tables_CopyTabD (resm->sVal2[0], res->sVal2, 0, gofw_NTestTypes - 1);+      tables_CopyTabD (resm->pVal2[0], res->pVal2, 0, gofw_NTestTypes - 1);+      smultin_DeleteRes (resm);+   }+   smultin_DeleteParam (par);+}+++/*=========================================================================*/++static void WriteDataRun (unif01_Gen * gen, char *TestName,+   long N, long n, int r, lebool Up)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   Up = %5s\n\n", Up ? "TRUE" : "FALSE");+}+++/*-------------------------------------------------------------------------*/++void sknuth_Run (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, lebool Up)+{+   long Seq;                      /* Replication number */+   double U;+   double UPrec;                  /* Preceding value of U */+   double nReal = n;+   double A[6][6];+   double B[6];+   double *NbExp;+   long k;+   int j, i;+   long Longueur;                 /* Current length of the sequence */+   double Khi;+   long *Count;+   char str[LENGTH + 1];+   double V[1];                   /* Number degrees of freedom for Chi2 */+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sknuth_Run test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataRun (gen, TestName, N, n, r, Up);++   if (n < 600)+      return;+   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, 6, "sknuth_Run");+   NbExp = res->NbExp;+   Count = res->Count;+   res->jmin = 1;+   res->jmax = 6;++   A[0][0] =   4529.35365;+   A[0][1] =   9044.90208;+   A[0][2] =  13567.9452;+   A[0][3] =  18091.2672;+   A[0][4] =  22614.7139;+   A[0][5] =  27892.1588;+   A[1][1] =  18097.0254;+   A[1][2] =  27139.4552;+   A[1][3] =  36186.6493;+   A[1][4] =  45233.8198;+   A[1][5] =  55788.8311;+   A[2][2] =  40721.3320;+   A[2][3] =  54281.2656;+   A[2][4] =  67852.0446;+   A[2][5] =  83684.5705;+   A[3][3] =  72413.6082;+   A[3][4] =  90470.0789;+   A[3][5] = 111580.110;+   A[4][4] = 113261.815;+   A[4][5] = 139475.555;+   A[5][5] = 172860.170;++   for (i = 2; i <= 6; i++) {+      for (j = 1; j < i; j++)+         A[i - 1][j - 1] = A[j - 1][i - 1];+   }++   B[0] = 1.0 / 6.0;+   B[1] = 5.0 / 24.0;+   B[2] = 11.0 / 120.0;+   B[3] = 19.0 / 720.0;+   B[4] = 29.0 / 5040.0;+   B[5] = 1.0 / 840.0;+   for (i = 1; i <= 6; i++) {+      NbExp[i] = nReal * B[i - 1];+      res->Loc[i] = i;+   }++   if (swrite_Classes)+      /* gofs_Classes (NbExp, NULL, 1, 6, 0); */+      tables_WriteTabD (NbExp, 1, 6, 1, 20, 2, 1, "Expected numbers:");++   statcoll_SetDesc (res->sVal1,+      "The N statistic values (a ChiSquare with 6 degrees of freedom):");+   res->degFree = 6;++   /* Beginning of test */+   for (Seq = 1; Seq <= N; Seq++) {+      for (i = 1; i <= 6; i++)+         Count[i] = 0;+      Longueur = 1;+      UPrec = unif01_StripD (gen, r);+      /* Generate n numbers */+      for (k = 1; k < n; k++) {+         U = unif01_StripD (gen, r);+         if ((Up && U < UPrec) || (!Up && U > UPrec)) {+            /* The end of a "Run" */+            ++Count[Longueur];+            Longueur = 1;+         } else if (Longueur < 6)+            ++Longueur;+         UPrec = U;+      }+      ++Count[Longueur];++      if (swrite_Counters)+         tables_WriteTabL (Count, 1, 6, 5, 10, "Observed numbers:");++      /* Compute modified Chi2 for a sequence */+      Khi = 0.0;+      for (i = 1; i <= 6; i++) {+	 for (j = 1; j <= 6; j++) {+	    Khi += A[i-1][j-1]*(Count[i] - NbExp[i])*(Count[j] - NbExp[j]);+	 }+      }+      statcoll_AddObs (res->sVal1, Khi / (nReal - 6.0));+   }++   V[0] = 6;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      swrite_AddStrChi (str, LENGTH, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++void sknuth_RunIndep (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, lebool Up)+{+   long Seq;                      /* Replication number */+   double U;+   double UPrec;                  /* Preceding value of U */+   double X2;+   long Nb;+   long k;+   int i;+   long Longueur;                 /* Current length of the sequence */+   long *Count;+   double *NbExp;+   double Prob[7];+   char str[LENGTH + 1];+   double V[1];                   /* Number degrees of freedom for Chi2 */+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sknuth_RunIndep test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataRun (gen, TestName, N, n, r, Up);++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, 6, "sknuth_RunIndep");+   NbExp = res->NbExp;+   Count = res->Count;+   res->jmin = 1;+   res->jmax = 6;+   sprintf (str, "NumExpected[6] < %.1f", gofs_MinExpected);++   for (i = 1; i <= 5; i++) {+      Prob[i] = 1.0 / num2_Factorial (i) - 1.0 / num2_Factorial (i + 1);+   }+   Prob[6] = 1.0 / num2_Factorial (6);++   statcoll_SetDesc (res->sVal1,+      "The N statistic values (a ChiSquare with 5 degrees of freedom):");+   res->degFree = 5;++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = 1; i <= 6; i++)+         Count[i] = 0;+      Longueur = 1;+      UPrec = unif01_StripD (gen, r);+      for (k = 1; k <= n; k++) {+         U = unif01_StripD (gen, r);+         if ((Up && U < UPrec) || (!Up && U > UPrec)) {+            /* The end of a "Run" */+            ++Count[Longueur];+            Longueur = 1;+            U = unif01_StripD (gen, r);+         } else if (Longueur < 6)+            ++Longueur;+         UPrec = U;+      }+      ++Count[Longueur];++      Nb = 0;+      for (i = 1; i <= 6; i++)+         Nb += Count[i];+      for (i = 1; i <= 6; i++)+         NbExp[i] = Nb * Prob[i];++      if (swrite_Counters) {+         tables_WriteTabD (NbExp, 1, 6, 1, 20, 2, 1, "Expected numbers:");+         tables_WriteTabL (Count, 1, 6, 1, 17, "Observed numbers:");+      }+      /*     util_Warning (NbExp[6] < gofs_MinExpected, str); */++      X2 = gofs_Chi2 (NbExp, Count, 1, 6);+      statcoll_AddObs (res->sVal1, X2);+   }++   V[0] = 5;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      swrite_AddStrChi (str, LENGTH, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataMaxOft (unif01_Gen * gen, char *TestName,+   long N, long n, int r, int d, int t, double NbExp)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   d = %4d,   t = %2d\n\n", d, t);+   printf ("      Number of categories = %d\n", d);+   printf ("      Expected number per category  = %.2f\n\n", NbExp);+}+++/*-------------------------------------------------------------------------*/++static double FDistMax (+   double Par[],             /* The parameter t = Par[0] */+   double x                  /* The argument */+   )+/*+ * Distribution function for the maximum of t random variables U01 = x^t+ */+{+  /*   double Prod;+   int j;+   const int t = Par[0] + 0.5;+  */+   if (x >= 1.0)+      return 1.0;+   if (x <= 0.0)+      return 0.0;+   return pow (x, Par[0]);+   /*+   Prod = x;+   for (j = 1; j < t; j++)+      Prod *= x;+   return Prod;+   */+}+++/*-------------------------------------------------------------------------*/++void sknuth_MaxOft (unif01_Gen * gen, sknuth_Res1 * res,+   long N, long n, int r, int d, int t)+{+   long Seq;                      /* Replication number */+   double tReal = t;+   double dReal = d;+   double NbExp;                  /* Expected number in each class */+   double MaxU;+   double U;+   long Groupe;+   int j, Indice;+   double *P;+   double Par[1];+   double X2;+   double V[1];                   /* Number degrees of freedom for Chi2 */+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sknuth_MaxOft test";+   sres_Basic *Bas;+   sres_Chi2 *Chi;++   Timer = chrono_Create ();+   Par[0] = t;++   NbExp = n / dReal;+   if (swrite_Basic)+      WriteDataMaxOft (gen, TestName, N, n, r, d, t, NbExp);+   util_Assert (NbExp >= gofs_MinExpected,+      "MaxOft:   NbExp < gofs_MinExpected");+   if (res == NULL) {+      localRes = TRUE;+      res = sknuth_CreateRes1 ();+   }+   InitRes1 (res, N, d);+   Bas = res->Bas;+   Chi = res->Chi;+   Chi->jmin = 0;+   Chi->jmax = d - 1;+   for (j = 0; j < d; j++) {+      Chi->Loc[j] = j;+      Chi->NbExp[j] = NbExp;+   }++   sprintf (str, "The N statistic values (a ChiSquare with %1d degrees"+                 " of freedom):", d - 1);+   statcoll_SetDesc (Chi->sVal1, str);+   Chi->degFree = d - 1;+   statcoll_SetDesc (Bas->sVal1,+      "The N statistic values (the Anderson-Darling p-values):");+   P = util_Calloc ((size_t) n + 1, sizeof (double));++   for (Seq = 1; Seq <= N; Seq++) {+      for (Indice = 0; Indice < d; Indice++)+         Chi->Count[Indice] = 0;+      for (Groupe = 1; Groupe <= n; Groupe++) {+         /* Generate a vector and find the max value */+         MaxU = unif01_StripD (gen, r);+         for (j = 1; j < t; j++) {+            U = unif01_StripD (gen, r);+            if (U > MaxU)+               MaxU = U;+         }+         /* For the chi2 */+         Indice = pow (MaxU, tReal) * dReal;+         ++Chi->Count[Indice];++         /* For the Anderson-Darling */+         P[Groupe] = MaxU;+      }+      if (swrite_Counters)+         tables_WriteTabL (Chi->Count, 0, d - 1, 5, 10, "Observed numbers:");++      /* Value of the chi2 statistic */+      X2 = gofs_Chi2Equal (NbExp, Chi->Count, 0, d - 1);+      statcoll_AddObs (Chi->sVal1, X2);++      /* Value of the Anderson-Darling statistic */+      gofw_ActiveTests1 (P, n, FDistMax, Par, Bas->sVal2, Bas->pVal2);+      statcoll_AddObs (Bas->sVal1, Bas->pVal2[gofw_AD]);+   }+   util_Free (P);++   V[0] = d - 1;+   gofw_ActiveTests2 (Chi->sVal1->V, Chi->pVal1->V, N, wdist_ChiSquare, V,+      Chi->sVal2, Chi->pVal2);+   Chi->pVal1->NObs = N;+   sres_GetChi2SumStat (Chi);++   gofw_ActiveTests2 (Bas->sVal1->V, Bas->pVal1->V, N, wdist_Unif,+      (double *) NULL, Bas->sVal2, Bas->pVal2);+   Bas->pVal1->NObs = N;++   if (swrite_Collectors) {+      statcoll_Write (Chi->sVal1, 5, 14, 4, 3);+      statcoll_Write (Bas->sVal1, 5, 14, 4, 3);+   }+   if (swrite_Basic) {+      if (N == 1) {+         swrite_AddStrChi (str, LENGTH, Chi->degFree);+         gofw_WriteActiveTests2 (N, Chi->sVal2, Chi->pVal2, str);+      } else {+         printf ("\n-----------------------------------------------\n");+         printf ("Test results for chi2 with %2ld degrees of freedom:\n",+                 Chi->degFree);+         gofw_WriteActiveTests0 (N, Chi->sVal2, Chi->pVal2);+         swrite_Chi2SumTest (N, Chi);+      }++      if (N == 1) {+         gofw_WriteActiveTests2 (N, Bas->sVal2, Bas->pVal2,+            "Anderson-Darling statistic            :");+      } else {+         printf ("\n-----------------------------------------------\n");+         printf ("Test results for Anderson-Darling:\n");+         gofw_WriteActiveTests0 (N, Bas->sVal2, Bas->pVal2);+      }+      printf ("\n");+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sknuth_DeleteRes1 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++void sknuth_Collision (unif01_Gen * gen, sknuth_Res2 * res,+   long N, long n, int r, long d, int t)+{+   double ValDelta[] = { -1.0 };+   smultin_Param *par;++   if (swrite_Basic)+      printf ("***********************************************************\n"+              "Test sknuth_Collision calling smultin_Multinomial\n\n");++   par = smultin_CreateParam (1, ValDelta, smultin_GenerCellSerial, -3);+   if (NULL == res) {+      smultin_Multinomial (gen, par, NULL, N, n, r, d, t, TRUE);+   } else {+      smultin_Res *resm;+      resm = smultin_CreateRes (par);+      smultin_Multinomial (gen, par, resm, N, n, r, d, t, TRUE);+      InitRes2 (res, N, resm->Mu[0], "sknuth_Collision");+      statcoll_SetDesc (res->Bas->sVal1, "Collision sVal1");+      statcoll_SetDesc (res->Pois->sVal1, "Collision sVal1");+      res->Pois->sVal1->NObs = resm->Collector[0]->NObs;+      res->Bas->sVal1->NObs = resm->Collector[0]->NObs;+      res->Pois->pLeft = resm->pCollLeft;+      res->Pois->pRight = resm->pCollRight;+      tables_CopyTabD (resm->Collector[0]->V, res->Bas->sVal1->V, 1, N);+      tables_CopyTabD (resm->Collector[0]->V, res->Pois->sVal1->V, 1, N);+      res->Pois->pVal2 = resm->pColl;+      res->Pois->sVal2 = resm->NbCollisions;+      tables_CopyTabD (resm->sVal2[0], res->Bas->sVal2, 0,+         gofw_NTestTypes - 1);+      tables_CopyTabD (resm->pVal2[0], res->Bas->pVal2, 0,+         gofw_NTestTypes - 1);+      smultin_DeleteRes (resm);+   }+   smultin_DeleteParam (par);+}+++/*=========================================================================*/++void sknuth_CollisionPermut (unif01_Gen * gen, sknuth_Res2 * res,+   long N, long n, int r, int t)+{+   double ValDelta[] = { -1.0 };+   smultin_Param *par;++   if (swrite_Basic)+      printf ("***********************************************************\n"+         "Test sknuth_CollisionPermut calling smultin_Multinomial\n\n");++   par = smultin_CreateParam (1, ValDelta, smultin_GenerCellPermut, -3);+   if (NULL == res) {+      smultin_Multinomial (gen, par, NULL, N, n, r, 0, t, TRUE);+   } else {+      smultin_Res *resm;+      resm = smultin_CreateRes (par);+      smultin_Multinomial (gen, par, resm, N, n, r, 0, t, TRUE);+      InitRes2 (res, N, resm->Mu[0], "sknuth_CollisionPermut");+      statcoll_SetDesc (res->Bas->sVal1, "CollisionPermut sVal1");+      statcoll_SetDesc (res->Pois->sVal1, "CollisionPermut sVal1");+      res->Pois->pLeft = resm->pCollLeft;+      res->Pois->pRight = resm->pCollRight;+      res->Pois->sVal1->NObs = resm->Collector[0]->NObs;+      res->Bas->sVal1->NObs = resm->Collector[0]->NObs;+      tables_CopyTabD (resm->Collector[0]->V, res->Bas->sVal1->V, 1, N);+      tables_CopyTabD (resm->Collector[0]->V, res->Pois->sVal1->V, 1, N);+      res->Pois->pVal2 = resm->pColl;+      res->Pois->sVal2 = resm->NbCollisions;+      tables_CopyTabD (resm->sVal2[0], res->Bas->sVal2, 0,+         gofw_NTestTypes - 1);+      tables_CopyTabD (resm->pVal2[0], res->Bas->pVal2, 0,+         gofw_NTestTypes - 1);+      smultin_DeleteRes (resm);+   }+   smultin_DeleteParam (par);+}
+ cbits/testu/src/smarsa.c view
@@ -0,0 +1,1664 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           smarsa.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "gdef.h"+#include "util.h"+#include "tables.h"+#include "chrono.h"+#include "num.h"++#include "smarsa.h"+#include "smultin.h"+#include "wdist.h"+#include "swrite.h"+#include "unif01.h"++#include "vectorsF2.h"++#include "gofs.h"+#include "gofw.h"+#include "fdist.h"+#include "fbar.h"+#include "fmass.h"+#include "statcoll.h"++#include <math.h>+#include <stdio.h>+#include <stdlib.h>+++#define LENGTH 200++/* MAXK = 2^64 */+#define STR_MAXK "18446744073709551616"++++/*---------------------------- Extern variables ---------------------------*/++#ifdef USE_LONGLONG+double smarsa_Maxk = 18446744073709551616.0;   /* 2^64 */ +#else+double smarsa_Maxk = num_MaxIntDouble;        /* 2^53 */+#endif+++++/*------------------------------- Functions -------------------------------*/++static void WriteResultsPoisson (sres_Poisson *res, long N)+{+   printf ("\n----------------------------------------------------"+           "\nTotal expected number = N*Lambda      : ");+   num_WriteD (N * res->Lambda, 10, 2, 2);+   printf ("\nTotal observed number                 : %7ld\n",+      (long) res->sVal2);+   gofw_Writep1 (res->pVal2);+   printf ("\n");+}+++/*=========================================================================*/++static void InitRes (+   smarsa_Res *res,            /* Results holder */+   long N,                     /* Number of replications */+   double Lambda,              /* Poisson mean */+   char *nam                   /* Test name */+)+/* + * Initializes res+ */+{+   sres_InitBasic (res->Bas, N, nam);+   sres_InitPoisson (res->Pois, N, Lambda, nam);+}+++/*-------------------------------------------------------------------------*/++smarsa_Res * smarsa_CreateRes (void)+{+   smarsa_Res *res;+   res = util_Malloc (sizeof (smarsa_Res));+   res->Bas = sres_CreateBasic ();+   res->Pois = sres_CreatePoisson ();+   res->Pois->pLeft = -1.0;+   res->Pois->pRight = -1.0;+   return res;+}+++/*-------------------------------------------------------------------------*/++void smarsa_DeleteRes (smarsa_Res *res)+{+   if (res == NULL)+      return;+   sres_DeleteBasic (res->Bas);+   sres_DeletePoisson (res->Pois);+   util_Free (res);+}+++/*=========================================================================*/++static void InitRes2 (+   smarsa_Res2 *res,          /* Results holder */+   long N,                    /* Number of replications */+   int jmax,                  /* Max class index for GCD */+   int tmax                   /* Max class index for NumIter */+)+/* + * Initializes the smarsa_Res2 structure+ */+{+   sres_InitChi2 (res->GCD, N, jmax, "smarsa_GCD:   GCD");+   sres_InitChi2 (res->NumIter, N, tmax, "smarsa_GCD:   NumIter");+}+++/*-------------------------------------------------------------------------*/++smarsa_Res2 *smarsa_CreateRes2 (void)+{+   smarsa_Res2 *res;+   res = util_Malloc (sizeof (smarsa_Res2));+   res->GCD = sres_CreateChi2 ();+   res->NumIter = sres_CreateChi2 ();+   return res;+}+++/*-------------------------------------------------------------------------*/++void smarsa_DeleteRes2 (smarsa_Res2 *res)+{+   if (res == NULL)+      return;+   sres_DeleteChi2 (res->GCD);+   sres_DeleteChi2 (res->NumIter);+   util_Free (res);+}+++/*=========================================================================*/++void smarsa_SerialOver (unif01_Gen *gen, sres_Basic *res,+   long N, long n, int r, long d, int t)+{+   double ValDelta[] = { 1.0 };+   smultin_Param *par;++   if (swrite_Basic)+      printf ("***********************************************************\n"+         "Test smarsa_SerialOver calling smultin_MultinomialOver\n\n");++   par = smultin_CreateParam (1, ValDelta, smultin_GenerCellSerial, 0);+   if (NULL == res) {+      smultin_MultinomialOver (gen, par, NULL, N, n, r, d, t, FALSE);+   } else {+      smultin_Res *resm;+      resm = smultin_CreateRes (par);+      smultin_MultinomialOver (gen, par, resm, N, n, r, d, t, FALSE);+      sres_InitBasic (res, N, "smarsa_SerialOver");+      statcoll_SetDesc (res->sVal1, "SerialOver sVal1");+      res->sVal1->NObs = resm->Collector[0]->NObs;+      tables_CopyTabD (resm->Collector[0]->V, res->sVal1->V, 1, N);+      tables_CopyTabD (resm->sVal2[0], res->sVal2, 0, gofw_NTestTypes - 1);+      tables_CopyTabD (resm->pVal2[0], res->pVal2, 0, gofw_NTestTypes - 1);+      smultin_DeleteRes (resm);+   }+   smultin_DeleteParam (par);+}+++/*=========================================================================*/++void smarsa_CollisionOver (unif01_Gen *gen, smarsa_Res *res,+   long N, long n, int r, long d, int t)+{+   double ValDelta[] = { -1.0 };+   smultin_Param *par;++   if (swrite_Basic)+      printf ("***********************************************************\n"+         "Test smarsa_CollisionOver calling smultin_MultinomialOver\n\n");++   par = smultin_CreateParam (1, ValDelta, smultin_GenerCellSerial, 3);+   if (NULL == res) {+      smultin_MultinomialOver (gen, par, NULL, N, n, r, d, t, TRUE);+   } else {+      smultin_Res *resm;+      resm = smultin_CreateRes (par);+      smultin_MultinomialOver (gen, par, resm, N, n, r, d, t, TRUE);+      InitRes (res, N, resm->Mu[0], "smarsa_CollisionOver");+      statcoll_SetDesc (res->Bas->sVal1, "CollisionOver sVal1");+      statcoll_SetDesc (res->Pois->sVal1, "CollisionOver sVal1");+      res->Pois->sVal1->NObs = resm->Collector[0]->NObs;+      res->Bas->sVal1->NObs = resm->Collector[0]->NObs;+      tables_CopyTabD (resm->Collector[0]->V, res->Bas->sVal1->V, 1, N);+      tables_CopyTabD (resm->Collector[0]->V, res->Pois->sVal1->V, 1, N);+      res->Pois->pVal2 = resm->pColl;+      if (resm->CollApprox == smultin_CollPoissonSparse)+         res->Pois->sVal2 = resm->NbCollisions;+      else+         res->Pois->sVal2 = resm->NbCells[0];+      tables_CopyTabD (resm->sVal2[0], res->Bas->sVal2, 0,+         gofw_NTestTypes - 1);+      tables_CopyTabD (resm->pVal2[0], res->Bas->pVal2, 0,+         gofw_NTestTypes - 1);+      smultin_DeleteRes (resm);+   }+   smultin_DeleteParam (par);+}+++/*=========================================================================*/++void smarsa_Opso (unif01_Gen * gen, smarsa_Res * res, long N, int r, int p)+{+   int d;+   long NBalls;++   switch (p) {+   case 1:+      NBalls = 2097152;+      d = 1024;+      break;+   case 2:+      NBalls = 4194304;+      d = 2048;+      break;+   case 3:+      NBalls = 8388608;+      d = 2048;+      break;+   default:+      util_Error ("smarsa_Opso:  p must be in {1, 2, 3}");+   }++   if (swrite_Basic)+      printf ("***********************************************************\n"+         "Test smarsa_Opso calling smarsa_CollisionOver\n\n");+   smarsa_CollisionOver (gen, res, N, NBalls, r, d, 2);+}+++/*=========================================================================*/+/*+ * The CPU time needed for BirthdaySpacings is 6 times longer when I used+ * the standard function qsort of stdlib.h. Thus we use our own QuickSort.+ */++#undef QSORT+#ifdef QSORT+static int compareD (const void *p0, const void *q0)+{+   double x = *((const double *) p0);+   double y = *((const double *) q0);+   return (x < y) ? -1 : (x > y) ? 1 : 0;+}+/* qsort ((void *)(DatDiff + 1), (size_t) n, sizeof (double), compareD); */+#endif+++/*=========================================================================*/++static void WriteDataBirth (unif01_Gen * gen, char *TestName, long N, long n,+   int r, long d, int t, int p, double k, smultin_CellType kc,+   double Lambda)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",    d = %1ld,    t = %1d,    p = %1d\n\n", d, t, p);+#ifdef USE_LONGLONG+   if (kc == 0 && d > 1)    /* kc = 2^64 */+      printf ("\n      Number of cells = d^t = " STR_MAXK "\n");+   else+      printf ("\n      Number of cells = d^t = %18" PRIuLEAST64 "\n", kc);+#else+   printf ("\n      Number of cells = d^t = %16.0f\n", k);+#endif+   printf ("      Lambda = Poisson mean = ");+   num_WriteD (Lambda, 12, 4, 2);+   printf ("\n\n");+}+++/*-------------------------------------------------------------------------*/++void smarsa_BirthdaySpacings (unif01_Gen *gen, sres_Poisson *res,+   long N, long n, int r, long d, int t, int Order)+{+   long Seq;                      /* Replication number */+   long j;+   long Sum;+   double Y;                      /* Number of collisions */+   double k;+   smultin_CellType kc;+   double Lambda;                 /* Poisson mean */+   smultin_CellType *Dates, *DatDiff;+   fmass_INFO Mass;+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "smarsa_BirthdaySpacings test";++   Timer = chrono_Create ();+   kc = k = d;+   for (j = 2; j <= t; j++) {+      k *= d;+      kc *= d;+   }+   Lambda = (double) n * n / k * (n / 4.0);++   if (swrite_Basic)+      WriteDataBirth (gen, TestName, N, n, r, d, t, Order, k, kc, Lambda);++   if (d <= 1) {+      util_Warning (TRUE,+                    "smarsa_BirthdaySpacings:   d <= 1.  The test is not done.");+      return;+   }+   if (k > smarsa_Maxk) {+      util_Warning (TRUE,+        "smarsa_BirthdaySpacings:   d^t > smarsa_Maxk.  The test is not done.");+      return;+   }+   if (8.0 * N * Lambda > sqrt (sqrt (k))) {+      util_Warning (TRUE,+        "smarsa_BirthdaySpacings:   8N Lambda > k^(1/4).  The test is not done.");+      return;+   }+   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreatePoisson ();+   }+   sres_InitPoisson (res, N, Lambda, "smarsa_BirthdaySpacings");++   Dates = util_Calloc (1 + (size_t) n, sizeof (smultin_CellType));+   DatDiff = util_Calloc (1 + (size_t) n, sizeof (smultin_CellType));++   sprintf (str, "The N statistic values (a Poisson with mean %g):", Lambda);+   statcoll_SetDesc (res->sVal1, str);++   Sum = 0;+   for (Seq = 1; Seq <= N; Seq++) {+      /* Generate and sort the "birth dates" */+      if (Order == 2) {+         for (j = 1; j <= n; j++) {+            Dates[j] = smultin_GenerCellSerial2 (gen, r, t, d);+         }+      } else {+         for (j = 1; j <= n; j++) {+            Dates[j] = smultin_GenerCellSerial (gen, r, t, d);+         }+      }+#ifdef USE_LONGLONG +      tables_QuickSortULL (Dates, 1, n);+      /* Compute the differences between adjacent dates */+      gofs_DiffULL (Dates, DatDiff, 1, n, 0ULL, 1ULL);+      /* The last cell is a special case */+      DatDiff[n] = kc - Dates[n] + Dates[1];+      tables_QuickSortULL (DatDiff, 1, n);+#else+      tables_QuickSortD (Dates, 1, n);+      /* Compute the differences between adjacent dates */+      gofs_DiffD (Dates, DatDiff, 1, n, 0.0, 1.0);+      /* The last cell is a special case */+      DatDiff[n] = kc - Dates[n] + Dates[1];+      tables_QuickSortD (DatDiff, 1, n);+#endif++      /* Count the number of collisions in DatDiff */+      Y = 0.0;+      for (j = 2; j <= n; j++) {+         if (DatDiff[j] == DatDiff[j - 1])+            Y += 1.0;+      }+      Sum += Y;+      statcoll_AddObs (res->sVal1, Y);+      if (swrite_Counters) {+#ifdef USE_LONGLONG+         tables_WriteTabULL (Dates, 1, n, 3, 21, "Birthdates:");+         tables_WriteTabULL (DatDiff, 1, n, 3, 21, "Birthdate differences:");+#else+         tables_WriteTabD (Dates, 1, n, 4, 17, 0, 0, "Birthdates:");+         tables_WriteTabD (DatDiff, 1, n, 4, 17, 0, 0,+            "Birthdate differences:");+#endif+      }+   }++   res->sVal2 = Sum;+   Mass = fmass_CreatePoisson (N * Lambda);+   res->pLeft = fdist_Poisson2 (Mass, Sum);+   res->pRight = fbar_Poisson2 (Mass, Sum);+   fmass_DeletePoisson (Mass);+   res->pVal2 = gofw_pDisc (res->pLeft, res->pRight);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 1, 1);+   if (swrite_Basic) {+      WriteResultsPoisson (res, N);+      swrite_Final (gen, Timer);+   }+   util_Free (Dates);+   util_Free (DatDiff);+   if (localRes)+      sres_DeletePoisson (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataCAT (unif01_Gen *gen, char *TestName,+   long N, long n, int r, long d, int t, long S[], double Lambda)+{+   int i;+   swrite_Head (gen, TestName, N, n, r);+   printf (",    d = %1ld,    t = %1d\n\n", d, t);+   for (i = 0; i < t; i++) {+      printf ("      S[%1d] =  %1ld\n", i, S[i]);+   }+   printf ("\n      Lambda = Poisson mean = ");+   num_WriteD (Lambda, 12, 4, 2);+   printf ("\n\n");+}+++/*-------------------------------------------------------------------------*/++static void TestCATData (long d, int t, long S1[])+/*+ * Test that the key to search for has no overlap, that is cannot be+ * written as ABA, where A and B are parts of the key.+ */+{+   int i, j, s;+   long k1, k2;+   i = 0;+   j = t - 1;+   k1 = k2 = 0;+   while (i < j) {+      k1 = k1 * d + S1[i];+      k2 = 0;+      for (s = j; s < t; s++)+         k2 = k2 * d + S1[s];+      util_Assert (k1 != k2,+         "CATData:   target cell number of the form ABA");+      i++;+      j--;+   }+}+++/*-------------------------------------------------------------------------*/+#if 0+static void CATGenere1 (+   unif01_Gen *gen, +   long n,               /* Number of points */+   int r,                /* Drop the first r bits of each U01 */+   long d,               /* Number of segments on the 1-dim. line */+   int t,                /* Dimension */+   long Key,             /* Key to search for */+   long k1,              /* = d^(t-1) */+   long *Count           /* Number of times Key appears */+   )+/*+ * Generate the n points in the dense case and count the number of times+ * cell Key appears. This is the circular version with n points. It also+ * correspond to the case of aperiodic Key.+ */+{+   int j, i;+   long Indice = 0;+   long Y = 0;                    /* Counter */+   long Premier[32];++   util_Assert (t <= 32, "smarsa_CAT.Genere:   t > 32");++   /* Generation of the first (t - 1) elements of the first tuple */+   for (j = 1; j < t; j++) {+      Premier[j] = unif01_StripL (gen, r, d);+      Indice = Indice * d + Premier[j];+   }++   /* Generation of the n - (tt - 1) tuples */+   for (j = 1; j <= n - (t - 1); j++) {+      /* Remove the leftmost component ... */+      Indice %= k1;+      /* ... shift and get another for the rightmost one */+      Indice = Indice * d + unif01_StripL (gen, r, d);+      if (Indice == Key) {+         ++Y;+         /* Key found: jump over the whole Indice and restart */+         Indice = 0;+         for (i = 1; i < t; i++) {+            Indice = Indice * d + unif01_StripL (gen, r, d);+            j++;+         }+      }+   }++   /* Generation of the last (t - 1) tuples. We use numbers in array */+   /* Premier[] so that the sequence is in fact circular */+   for (j = 1; j < t; j++) {+      Indice %= k1;+      Indice = Indice * d + Premier[j];+      if (Indice == Key)+         ++Y;+   }++   *Count = Y;+}+#endif++/*-------------------------------------------------------------------------*/++static void CATGenere (+   unif01_Gen *gen, +   long n,               /* Number of points */+   int r,                /* Drop the first r bits of each U01 */+   long d,               /* Number of segments on the 1-dim. line */+   int t,                /* Dimension */+   long Key,             /* Key to search for */+   long k1,              /* = d^(t-1) */+   long *Count           /* Number of times Key appears */+   )+/*+ * Generate the n points in the dense case and count the number of times+ * cell Key appears. This is the non-circular version with n - t + 1 points.+ * It also correspond to the case of aperiodic Key.+ */+{+   int j, i;+   long Indice;+   long Y = 0;                    /* Counter */++   /* Generation of the first (t - 1) elements of the first tuple */+   Indice = 0;+   for (j = 1; j < t; j++)+      Indice = Indice * d + unif01_StripL (gen, r, d);++   /* Generation of the n - (tt - 1) tuples */+   for (j = 1; j <= n - (t - 1); j++) {+      /* Remove the leftmost component ... */+      Indice %= k1;+      /* ... shift and get another for the rightmost one */+      Indice = Indice * d + unif01_StripL (gen, r, d);+      if (Indice == Key) {+         ++Y;+         /* Key found: jump over the whole Indice and restart */+         Indice = 0;+         for (i = 1; i < t; i++) {+            Indice = Indice * d + unif01_StripL (gen, r, d);+            j++;+         }+      }+   }++   *Count = Y;+}+++/*-------------------------------------------------------------------------*/++void smarsa_CAT (unif01_Gen *gen, sres_Poisson *res,+   long N, long n, int r, long d, int t, long S[])+{+   long Seq;+   long i;+   double k;+   long k1;                       /* d^(t-1) */+   long Key;                      /* Cell number to search for */+   double Lambda;                 /* Poisson mean */+   long Sum;+   long Co;+   fmass_INFO Mass;+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "smarsa_CAT test";++   Timer = chrono_Create ();+   k1 = d;+   for (i = 2; i < t; i++)+      k1 *= d;+   k = k1 * d;+   Lambda = (n - t + 1) / k;+   if (swrite_Basic)+      WriteDataCAT (gen, TestName, N, n, r, d, t, S, Lambda);+   util_Assert (d > 1, "smarsa_CAT:   d <= 1");++   Key = 0;+   for (i = 0; i < t; i++) {+      if (S[i] < 0 || S[i] >= d) {+         util_Error ("smarsa_CAT:   S[i] must be in [0, d - 1]");+      }+      Key = Key * d + S[i];+   }+   TestCATData (d, t, S);+   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreatePoisson ();+   }+   sres_InitPoisson (res, N, Lambda, "smarsa_CAT");+   sprintf (str, "The N statistic values (a Poisson with mean %g):", Lambda);+   statcoll_SetDesc (res->sVal1, str);++   Sum = 0;+   for (Seq = 1; Seq <= N; Seq++) {+      CATGenere (gen, n, r, d, t, Key, k1, &Co);+      statcoll_AddObs (res->sVal1, (double) Co);+      Sum += Co;+   }++   res->sVal2 = Sum;+   Mass = fmass_CreatePoisson (res->Mu);+   res->pLeft = fdist_Poisson2 (Mass, Sum);+   res->pRight = fbar_Poisson2 (Mass, Sum);+   fmass_DeletePoisson (Mass);+   res->pVal2 = gofw_pDisc (res->pLeft, res->pRight);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 1, 1);+   if (swrite_Basic) {+      WriteResultsPoisson (res, N);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeletePoisson (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataCATBits (unif01_Gen *gen, char *TestName,+   long N, long n, int r, int s, int L, unsigned long Key, double Lambda)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   s = %1d,   L = %1d,   Key = %lu\n\n", s, L, Key);+   printf ("      Lambda = Poisson mean = ");+   num_WriteD (Lambda, 12, 4, 2);+   printf ("\n\n");+}+++/*-------------------------------------------------------------------------*/++static void TestCATBitsData (int L, unsigned long Key)+/*+ * Test that the key to search for has no overlap, that is cannot be+ * written as ABA, where A and B are parts of the key.+ */+{+   int i;+   unsigned long mask = 1, shift = L - 1;+   i = 0;+   while (i < L / 2) {+      if ((Key & mask) == (Key >> shift)) {+         bitset_WriteSet ("Key =  ", Key, L);+         util_Error ("CATBitsData:   Key of the form ABA");+      }+      i++;+      shift--;+      mask = num_TwoExp[i + 1] - 1.0;+   }+}+++/*-------------------------------------------------------------------------*/++static void CATGenerBits (unif01_Gen *gen, long n, int r, int s, +   int L, unsigned long KEY0, long *Count)+{+/*+ * Generate the bits in the CATBits test. Points are generated with+ * overlapping. We have a window of size L bits, and we slide it 1 bit+ * forward at each step to generate a point. We then check whether it+ * equals the L bits Key.+ */+   const unsigned long MASK0 = num_TwoExp[L] - 1.0;+   unsigned long Mask, Key, Z0, Z;+   int j0, j, k;+   long i;+   long co;++   util_Assert (L <= 32, "CATBits:   GenerBits:   L > 32");+   co = 0;++   if ((s >= L) && (L <= 16)) {+      const int q = s - L;++      /* Make sure to skip the first half of the loop for the first number+         since there is no previous Z */+      j0 = L;+      Z = 0;++      for (i = 0; i < n / s; i++) {+         Z0 = unif01_StripB (gen, r, s);++         /* The last L - j0 bits of the previous number */+         Mask = MASK0 << (L - j0);+         Key = KEY0 << (L - j0);+         Z |= (Z0 >> q);+         j = j0;+         while (j < L) {+            if (Key == (Z & Mask)) {+               co++;+               j += L;+               Mask >>= L;+               Key >>= L;+            } else {+               j++;+               Mask >>= 1;+               Key >>= 1;+            }+         }+         j0 = j % L;++         /* The first s - L bits of the current number */+         Z = Z0;+         Mask = MASK0 << (q - j0);+         Key = KEY0 << (q - j0);+         j = j0;+         while (j < q) {+            if (Key == (Z & Mask)) {+               co++;+               j += L;+               Mask >>= L;+               Key >>= L;+            } else {+               j++;+               Mask >>= 1;+               Key >>= 1;+            }+         }+         j0 = j - q;+         Z = Z0 << L;+      }++   } else if (s >= L) {+#ifdef USE_LONGLONG+      const ulonglong MASK0 = num_TwoExp[L] - 1.0;+      ulonglong Z, Z0;+      ulonglong Mask, Key;+      const int q = s - L;++      /* Make sure to skip the first half of the loop for the first number+         since there is no previous Z */+      j0 = L;+      Z = 0;++      for (i = 0; i < n / s; i++) {+         Z0 = unif01_StripB (gen, r, s);++         /* The last L - j0 bits of the previous number */+         Mask = MASK0 << (L - j0);+         Key = KEY0 << (L - j0);+         Z |= (Z0 >> q);+         j = j0;+         while (j < L) {+            if (Key == (Z & Mask)) {+               co++;+               j += L;+               Mask >>= L;+               Key >>= L;+            } else {+               j++;+               Mask >>= 1;+               Key >>= 1;+            }+         }+         j0 = j % L;++         /* The first s - L bits of the current number */+         Z = Z0;+         Mask = MASK0 << (q - j0);+         Key = KEY0 << (q - j0);+         j = j0;+         while (j < q) {+            if (Key == (Z & Mask)) {+               co++;+               j += L;+               Mask >>= L;+               Key >>= L;+            } else {+               j++;+               Mask >>= 1;+               Key >>= 1;+            }+         }+         j0 = j - q;+         Z = Z0 << L;+      }+#else+      if (L <= s)+         util_Error ("CATGenerBits:   L <= s and L > 16");+#endif++   } else if ((s < L) && (L + s <= 32)) {+      const int t = L / s;+      util_Assert (L % s == 0, "CATBits:   L > s but L % s not 0");++      /* Generation of the first L random bits */+      Z = 0;+      for (j = 0; j < t; j++) {+         Z <<= s;+         Z |= unif01_StripB (gen, r, s);+      }+      j0 = 0;++      /* Generation of the rest of the random bits */+      for (i = 0; i < (n - L) / s; i++) {+         Z = (Z << s) | unif01_StripB (gen, r, s);+         Mask = MASK0 << (s - j0);+         Key = KEY0 << (s - j0);+         j = j0;+         while (j < s) {+            if (Key == (Z & Mask)) {+               co++;+               j += L;+               i += t - 1;+               for (k = 1; k < t; k++) {+                  Z <<= s;+                  Z |= unif01_StripB (gen, r, s);+               }+            } else {+               j++;+               Mask >>= 1;+               Key >>= 1;+            }+         }+         j0 = j % s;+      }++   } else {+#ifdef USE_LONGLONG+      const ulonglong MASK0 = num_TwoExp[L] - 1.0;+      const int t = L / s;+      ulonglong Z;+      ulonglong Mask, Key, Key0 = KEY0;++      if (L > s) {+         util_Assert (L % s == 0, "CATBits:   L > s but L % s not 0");+      }++      /* Generation of the first L random bits */+      Z = 0;+      for (j = 0; j < t; j++) {+         Z <<= s;+         Z |= unif01_StripB (gen, r, s);+      }+      j0 = 0;++      /* Generation of the rest of the random bits */+      for (i = 0; i < (n - L) / s; i++) {+         Z = (Z << s) | unif01_StripB (gen, r, s);+         Mask = MASK0 << (s - j0);+         Key = Key0 << (s - j0);+         j = j0;+         while (j < s) {+            if (Key == (Z & Mask)) {+               co++;+               j += L;+               i += t - 1;+               for (k = 1; k < t; k++) {+                  Z <<= s;+                  Z |= unif01_StripB (gen, r, s);+               }+            } else {+               j++;+               Mask >>= 1;+               Key >>= 1;+            }+         }+         j0 = j % s;+      }+#else+      if (L == s)+         util_Error ("CATGenereBits:   L = s and s > 16");+      else+         util_Error ("CATGenereBits:   L > s and L + s > 32");+#endif+   }++   *Count = co;+}+++/*-------------------------------------------------------------------------*/++void smarsa_CATBits (unif01_Gen *gen, sres_Poisson *res,+   long N, long n, int r, int s, int L, unsigned long Key)+{+   long Seq;+   double Lambda;                 /* Poisson mean */+   long Sum;+   long Co;+   fmass_INFO Mass;+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "smarsa_CATBits test";++   Timer = chrono_Create ();+   Lambda = (n - L + 1) / num_TwoExp[L];+   if (swrite_Basic)+      WriteDataCATBits (gen, TestName, N, n, r, s, L, Key, Lambda);+   util_Assert (L > 1, "smarsa_CATBits:   L <= 1");++   TestCATBitsData (L, Key);+   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreatePoisson ();+   }+   sres_InitPoisson (res, N, Lambda, "smarsa_CATBits");+   sprintf (str, "The N statistic values (a Poisson with mean %g):", Lambda);+   statcoll_SetDesc (res->sVal1, str);++   Sum = 0;+   for (Seq = 1; Seq <= N; Seq++) {+      CATGenerBits (gen, n, r, s, L, Key, &Co);+      statcoll_AddObs (res->sVal1, (double) Co);+      Sum += Co;+   }++   res->sVal2 = Sum;+   Mass = fmass_CreatePoisson (res->Mu);+   res->pLeft = fdist_Poisson2 (Mass, Sum);+   res->pRight = fbar_Poisson2 (Mass, Sum);+   fmass_DeletePoisson (Mass);+   res->pVal2 = gofw_pDisc (res->pLeft, res->pRight);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 1, 1);+   if (swrite_Basic) {+      WriteResultsPoisson (res, N);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeletePoisson (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataMatRank (unif01_Gen * gen, char *TestName,+   long N, long n, int r, int s, int L, int k)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",    s = %1d,    L = %1d,    k = %1d\n\n", s, L, k);+}+++/*-------------------------------------------------------------------------*/+#if 0++static int RankOfBitMatrix (bitset_BitSet M[], int maxrow)+/*+ * Calculation of the rank of the bit-matrix M+ */+{+   const int MaxBit = 31;         /* number of bits in a word - 1 */+   bitset_BitSet Swap;+   int rank = 0;+   int i;+   int CL = 1;++   while (CL <= MaxBit) {+      /* All components of M shift their bits 1 position to the left */+      for (i = 0; i < maxrow; i++)+         M[i] <<= 1;++      /* Search of the first M[i] with 1 as the major bit */+      i = rank;+      for (;;) {+         if ((bitset_TestBit (M[i], MaxBit)) || (i == maxrow - 1))+            break;+         ++i;+      }+      /* Diagonalization of matrix M */+      if (i < maxrow - 1) {+         Swap = M[rank];+         M[rank] = M[i];+         M[i] = Swap;+         for (i = rank + 1; i < maxrow; i++) {+            if (bitset_TestBit (M[i], MaxBit))+               M[i] ^= M[rank];+         }+         ++rank;+         if (rank == MaxBit)+            return rank;+      }+      ++CL;+   }+   return rank;+}+++/*-------------------------------------------------------------------------*/++#define lmax 64++void smarsa_MatrixRank (unif01_Gen *gen, sres_Chi2 *res,+   long N, long n, int r, int s, int l, int k)+{+   long Seq;+   long Rep;+   int j;+   int i;+   long L;                        /* One line of bits */+   int c;                         /* Number-1 of U01 used to build a line */+   long d;                        /* Get s bits of a generated U01 */+   long a;                        /* Get b bits of a generated U01 */+   int b;                         /* Number of bits of last U01 of a line */+   int Minkl;                     /* Min (k, l) */+   long NbGroups;                 /* Number of classes for ChiSquare */+   long jhigh;                    /* Index of the highest class */+   long jlow;                     /* Index of the lowest class */+   int Rank;                      /* Rank of matrix */+   double X2;+   double Prod;+   long *Loca;                    /* Redirections in merging Chi2 classes */+   long *Count;                   /* Observed numbers */+   double *NbExp;                 /* Expected numbers */+   bitset_BitSet M[lmax];         /* Matrix */+   double V[1];                   /* Number of degrees of freedom for Chi2 */+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "smarsa_MatrixRank test";++   Timer = chrono_Create ();+   /* We shall need c + 1 random numbers to build a line of the matrix */+   c = k / s;+   b = k % s;+   a = num_TwoExp[b];+   d = num_TwoExp[s];+   if (swrite_Basic)+      WriteDataMatRank (gen, TestName, N, n, r, s, l, k);+   if (k <= l)+      Minkl = k;+   else+      Minkl = l;+   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, Minkl, "smarsa_MatrixRank");+   NbExp = res->NbExp;+   Count = res->Count;+   Loca = res->Loc;++   Prod = n * pow (2.0, -(double) (l * k));+   NbExp[0] = Prod;+   for (j = 1; j <= Minkl; j++) {+      Prod = Prod * pow (2.0,  (double) (l + k - 2*j + 1)) *+                (1.0 - 1.0 / num_TwoExp[l - j + 1]) *+                (1.0 - 1.0 / num_TwoExp[k - j + 1]) /+                (1.0 - 1.0 / num_TwoExp[j]);+      NbExp[j] = Prod;+   }++   jlow = 0;+   jhigh = Minkl;+   if (swrite_Classes)+      gofs_WriteClasses (NbExp, Loca, jlow, jhigh, 0);+   gofs_MergeClasses (NbExp, Loca, &jlow, &jhigh, &NbGroups);+   if (swrite_Classes)+      gofs_WriteClasses (NbExp, Loca, jlow, jhigh, NbGroups);+   res->jmin = jlow;+   res->jmax = jhigh;+   res->degFree = NbGroups - 1;++   util_Assert (n > 2.0 * gofs_MinExpected,+      "smarsa_MatrixRank:    n <= 2*gofs_MinExpected");+   util_Assert (k <= 31, "smarsa_MatrixRank:   k > 31");+   util_Assert (l <= lmax, "smarsa_MatrixRank:   L > 64");+   util_Assert (l * k <= 1020, "smarsa_MatrixRank:   L*k > 1020");+   util_Assert (NbGroups > 1,+      "smarsa_MatrixRank:   number of classes = 1."+      "   Increase  n  or decrease  |L - k|");++   sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"+                 " of freedom):", NbGroups - 1);+   statcoll_SetDesc (res->sVal1, str);++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = jlow; i <= jhigh; i++)+         Count[i] = 0;+      for (Rep = 1; Rep <= n; Rep++) {+         /* Generate the l x k matrix and compute its rank */+         for (i = 0; i < l; i++) {+            /* Build one line of bits L */+            L = 0;+            for (j = 1; j <= c; j++)+               /* Generate s bits */+               L = d * L + unif01_StripB (gen, r, s);+            /* The last b bits of a line of the matrix */+            if (a > 1)+               L = a * L + unif01_StripB (gen, r, b);+            M[i] = L;+         }+         /* Set all remaining lines to 0 */+         for (i = l; i < lmax; i++)+            M[i] = 0;++         Rank = RankOfBitMatrix (M, lmax);+         ++Count[Loca[Rank]];+      }++      X2 = gofs_Chi2 (NbExp, Count, jlow, jhigh);+      statcoll_AddObs (res->sVal1, X2);+      if (swrite_Counters)+         tables_WriteTabL (Count, jlow, jhigh, 5, 12, "Observed Numbers");+   }++   V[0] = NbGroups - 1;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+                      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   /* !!!! Attention, this Write must use the right pVal */+   if (swrite_Basic) {+      swrite_AddStrChi (str, LENGTH + 1, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}++#endif++/*=========================================================================*/+#if 0+static void ZeroMat (Matrix * M)+{+   int i;++   for (i = 0; i < M->nblignes; i++)+      PutBVToZero (&(M->lignes[i][0]));+}+#endif++/*-------------------------------------------------------------------------*/++void smarsa_MatrixRank (unif01_Gen *gen, sres_Chi2 *res,+   long N, long n, int r, int s, int l, int k)+{+   long Seq;+   long Rep;+   int j;+   int i;+   int c;                         /* Number-1 of U01 used to build a line */+   int b;                         /* Number of bits of last U01 of a line */+   unsigned long bmask;           /* b bits mask */+   unsigned long smask;           /* s bits mask */+   int Minkl;                     /* Min (k, l) */+   long NbGroups;                 /* Number of classes for ChiSquare */+   long jhigh;                    /* Index of the highest class */+   long jlow;                     /* Index of the lowest class */+   int Rank;                      /* Rank of matrix */+   double X2;+   double temp;+   long *Loca;                    /* Redirections in merging Chi2 classes */+   long *Count;                   /* Observed numbers */+   double *NbExp;                 /* Expected numbers */+   double Par[1];                 /* Number of degrees of freedom for Chi2 */+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "smarsa_MatrixRank test";+   Matrix *M;+   BitVect *V;++   Timer = chrono_Create ();+   /* We shall need ceiling(c) random numbers to build a line of the matrix */+   c = k / s;+   b = k % s;+   bmask = num_TwoExp[b] - 1.0;+   /* The b most significant bits are set */+   bmask <<= vectorsF2_WL - b;+   smask = num_TwoExp[s] - 1.0;+   /* The s most significant bits are set */+   smask <<= vectorsF2_WL - s;++   if (swrite_Basic)+      WriteDataMatRank (gen, TestName, N, n, r, s, l, k);+   Minkl = util_Min (k, l);+   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, Minkl, "smarsa_MatrixRank");+   NbExp = res->NbExp;+   Count = res->Count;+   Loca = res->Loc;++   temp = num_Log2((double) n) - l * k;+   NbExp[0] = pow (2.0, temp);+   for (j = 1; j <= Minkl; j++) {+      temp += l + k - 2*j + 1 ++	      num_Log2(1.0 - pow (2.0, -(double) (l - j + 1))) ++	      num_Log2(1.0 - pow (2.0, -(double) (k - j + 1))) -+	      num_Log2(1.0 - pow (2.0, -(double) j));+      NbExp[j] = pow (2.0, temp);+   }++   jlow = 0;+   jhigh = Minkl;+   if (swrite_Classes)+      gofs_WriteClasses (NbExp, Loca, jlow, jhigh, 0);+   gofs_MergeClasses (NbExp, Loca, &jlow, &jhigh, &NbGroups);+   if (swrite_Classes)+      gofs_WriteClasses (NbExp, Loca, jlow, jhigh, NbGroups);+   res->jmin = jlow;+   res->jmax = jhigh;+   res->degFree = NbGroups - 1;++   util_Warning (NbGroups <= 1,+      "smarsa_MatrixRank:   number of Chi2 classes = 1.\n"+      "   Increase  n  or decrease  |L - k|.");+   if (res->degFree < 1) {+      if (localRes)+         sres_DeleteChi2 (res);+      return;+   }+   util_Assert (n >= 2.0 * gofs_MinExpected,+      "smarsa_MatrixRank:    n <= 2*gofs_MinExpected");++   sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"+                 " of freedom):", NbGroups - 1);+   statcoll_SetDesc (res->sVal1, str);++   M = util_Malloc (sizeof (Matrix));+   AllocMat (M, l, k, 1);++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = jlow; i <= jhigh; i++)+         Count[i] = 0;++      for (Rep = 1; Rep <= n; Rep++) {+         /* Generate the l x k matrix and compute its rank */+         for (i = 0; i < l; i++) {+            V = &(M->lignes[i][0]);+            /* Build one line of bits */+            for (j = 0; j < c; j++) {+               /* Shift by s and generate s new bits */+               BVRShiftSelf (V, s);+               V->vect[0] |= (smask &+                  (gen->GetBits (gen->param, gen->state) << r));+            }+            /* The last b bits of a line of the matrix */+            if (b > 0) {+               BVRShiftSelf (V, b);+               V->vect[0] |= (bmask &+                  (gen->GetBits (gen->param, gen->state) << r));+            }+         }+         Rank = GaussianElimination (M, l, k, 1);+         ++Count[Loca[Rank]];+      }++      X2 = gofs_Chi2 (NbExp, Count, jlow, jhigh);+      statcoll_AddObs (res->sVal1, X2);+      if (swrite_Counters)+         tables_WriteTabL (Count, jlow, jhigh, 5, 12, "Observed Numbers");+   }++   FreeMat (M);+   util_Free (M);++   Par[0] = NbGroups - 1;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, Par,+                      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   /* !!!! Attention, this Write must use the right pVal */+   if (swrite_Basic) {+      swrite_AddStrChi (str, LENGTH, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataSavir2 (unif01_Gen * gen, char *TestName,+   long N, long n, int r, long m, int t)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",    m = %1ld,    t = %1d\n\n", m, t);+}+++/*-------------------------------------------------------------------------*/++void smarsa_Savir2 (unif01_Gen *gen, sres_Chi2 *res,+   long N, long n, int r, long m, int t)+{+   const double eps = 1.0E-15;+   long I;+   long msup;                     /* Dimension - 1 of arrays */+   long Seq;+   long Rep;+   long j;+   int i;+   long NbGroups;                 /* Number of classes for ChiSquare */+   long jhigh;                    /* Index of the highest class */+   long jlow;                     /* Index of the lowest class */+   double X2;                     /* ChiSquare Statistic */+   double UnSurm = 1.0 / m;+   double *Prob;                  /* Probabilities */+   long *Loca;+   double V[1];                   /* Number degrees of freedom for Chi2 */+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "smarsa_Savir2 test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataSavir2 (gen, TestName, N, n, r, m, t);++   Prob = util_Calloc ((size_t) m + 2, sizeof (double));+   Prob[m + 1] = 0.0;+   for (j = 1; j <= m; j++)+      Prob[j] = UnSurm;+   for (i = 2; i <= t; i++) {+      for (j = m; j >= 1; j--)+         Prob[j] = Prob[j + 1] + Prob[j] / j;+   }+   j = 1;+   while (Prob[j] > eps)+      ++j;+   msup = j - 1;++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, msup, "smarsa_Savir2");++   for (j = 1; j <= msup; j++)+      res->NbExp[j] = Prob[j] * n;+   util_Free (Prob);+   Loca = res->Loc;++   jlow = 1;+   jhigh = msup;+   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, Loca, jlow, jhigh, 0);+   gofs_MergeClasses (res->NbExp, Loca, &jlow, &jhigh, &NbGroups);+   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, Loca, jlow, jhigh, NbGroups);+   res->jmin = jlow;+   res->jmax = jhigh;+   res->degFree = NbGroups - 1;++   util_Warning (NbGroups < 2,+      "smarsa_Savir2:   Number of classes = 1.\n   Decrease t or increase n.");+   if (res->degFree < 1) {+      if (localRes)+         sres_DeleteChi2 (res);+      return;+   }+   util_Assert (n >= 2.0 * gofs_MinExpected,+      "smarsa_Savir2:    n <= 2*gofs_MinExpected");++   sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"+                 " of freedom):", NbGroups - 1);+   res->sVal1 = statcoll_Create (N, str);++   for (Seq = 1; Seq <= N; Seq++) {+      for (j = jlow; j <= jhigh; j++)+         res->Count[j] = 0;+      for (Rep = 1; Rep <= n; Rep++) {+         I = m;+         for (i = 1; i <= t; i++)+            I = 1 + unif01_StripD (gen, r) * I;+         if (I > msup)+            ++res->Count[Loca[msup]];+         else+            ++res->Count[Loca[I]];+      }++      if (swrite_Counters)+         tables_WriteTabL (res->Count, jlow, jhigh, 5, 12,+            "Observed Numbers");++      X2 = gofs_Chi2 (res->NbExp, res->Count, jlow, jhigh);+      statcoll_AddObs (res->sVal1, X2);+   }++   V[0] = NbGroups - 1;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);+   if (swrite_Basic) {+      swrite_AddStrChi (str, LENGTH, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataGCD (unif01_Gen * gen, char *TestName,+   long N, long n, int r, int s)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   s = %1d\n\n", s);+}+++/*-------------------------------------------------------------------------*/++void smarsa_GCD (unif01_Gen *gen, smarsa_Res2 *res,+                 long N, long n, int r, int s)+{+  /*+   The theoretical distribution for the number of iterations is unknown.+   The binomial is a very rough approximation: thus the printing of the+   results is commented out.+   */+   const double C1 = 6 / (num_Pi * num_Pi);+   const double P1 = 0.376;+   const int KMAX = 50;+   unsigned long U, V, temp;+   double X;+   double Param[1];+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "smarsa_GCD test";+   sres_Chi2 *GCD;+   sres_Chi2 *NumIter;+   int jmax, j, k;+   long Seq, i;+   double *NbExp;+   long *Loc;+   long NbClasses;+   fmass_INFO Q;++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataGCD (gen, TestName, N, n, r, s);+   if (n < 30) {+      util_Warning (TRUE, "n < 30");+      return;+   }+   if (n > pow (2.0, 1.5*s)) {+      util_Warning (TRUE, "n > 2^(1.5s)");+      return;+   } +   if (res == NULL) {+      localRes = TRUE;+      res = smarsa_CreateRes2 ();+   }+   jmax = 1 + sqrt (C1 * n / gofs_MinExpected);+   util_Assert (jmax > 1, "smarsa_GCD:   jmax < 2");+   InitRes2 (res, N, jmax, KMAX);++   GCD = res->GCD;+   GCD->jmin = 1;+   GCD->jmax = jmax;+   GCD->degFree = jmax - 1;+   sprintf (str, "GCD; the N statistic values (a ChiSquare with %1d degrees"+                 " of freedom):", jmax - 1);+   statcoll_SetDesc (GCD->sVal1, str);++   /* Compute the probabilities for the GCD values */+   NbExp = GCD->NbExp;+   Loc = GCD->Loc;+   X = 0.0;+   for (j = 1; j < jmax; j++) {+      NbExp[j] = n * C1 / ((double) j * j);+      X += NbExp[j];+      Loc[j] = j;+   }+   NbExp[jmax] = n - X;++   if (swrite_Classes) {+      printf ("Classes for the GCD values:\n");+      gofs_WriteClasses (GCD->NbExp, GCD->Count, 1, jmax, 0);+   }++   NumIter = res->NumIter;+   /* Compute expected numbers for number of iterations */+   Q = fmass_CreateBinomial (KMAX, P1, 1.0 - P1);+   for (i = 0; i <= KMAX; i++)+      NumIter->NbExp[i] = n * fmass_BinomialTerm2 (Q, i);+   fmass_DeleteBinomial (Q);++   NumIter->jmin = 0;+   NumIter->jmax = KMAX;+   if (swrite_Classes) {+      printf ("\nClasses for the number of iterations:\n");+      gofs_WriteClasses (NumIter->NbExp, NumIter->Loc, NumIter->jmin,+                         NumIter->jmax, 0);+   }+   gofs_MergeClasses (NumIter->NbExp, NumIter->Loc, &NumIter->jmin,+                      &NumIter->jmax, &NbClasses);++   if (swrite_Classes)+      gofs_WriteClasses (NumIter->NbExp, NumIter->Loc, NumIter->jmin,+                         NumIter->jmax, NbClasses);++   sprintf (str, "NumIter; the N statistic values (a ChiSquare with %1ld"+                 " degrees of freedom):", NbClasses - 1);+   statcoll_SetDesc (NumIter->sVal1, str);+   NumIter->degFree = NbClasses - 1;+   util_Assert (NumIter->degFree >= 1, "NumIter->degFree < 1");++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = 0; i <= KMAX; i++)+         NumIter->Count[i] = 0;+      for (i = 0; i <= GCD->jmax; i++)+         GCD->Count[i] = 0;+      for (i = 1; i <= n; i++) {+         k = 0;+         do {+            U = unif01_StripB (gen, r, s);+            V = unif01_StripB (gen, r, s);+         } while (0 == U || 0 == V);+         do {+            temp = U % V;+            U = V;+            V = temp;+            k++;+         } while (V > 0);+         if ((long) U > GCD->jmax)+            U = GCD->jmax;+         (GCD->Count[U])++;+         if (k > KMAX)+            k = KMAX;+         (NumIter->Count[NumIter->Loc[k]])++;+      }+      if (swrite_Counters) {+         tables_WriteTabL (GCD->Count, GCD->jmin, GCD->jmax, 5, 10,+                           "Observed numbers for GCD values:");+ /*         tables_WriteTabL (NumIter->Count, NumIter->jmin, NumIter->jmax, 5,+                           10, "Observed numbers for number of iterations:");+ */+      }++      X = gofs_Chi2 (GCD->NbExp, GCD->Count, GCD->jmin, GCD->jmax);+      statcoll_AddObs (GCD->sVal1, X);+      X = gofs_Chi2 (NumIter->NbExp, NumIter->Count, NumIter->jmin,+                     NumIter->jmax);+      statcoll_AddObs (NumIter->sVal1, X);+   }++   Param[0] = GCD->degFree;+   gofw_ActiveTests2 (GCD->sVal1->V, GCD->pVal1->V, N, wdist_ChiSquare,+                      Param, GCD->sVal2, GCD->pVal2);+   GCD->pVal1->NObs = N;+   sres_GetChi2SumStat (GCD);+/*+   Param[0] = NumIter->degFree;+   gofw_ActiveTests2 (NumIter->sVal1->V, NumIter->pVal1->V, N,+      wdist_ChiSquare, Param, NumIter->sVal2, NumIter->pVal2);+   NumIter->pVal1->NObs = N;+*/++   if (swrite_Basic) {+      if (swrite_Collectors)+         statcoll_Write (GCD->sVal1, 5, 14, 4, 3);+      printf ("\n-----------------------------------------------\n");+      if (N == 1) {+         printf ("Number of degrees of freedom          : %4ld\n",+                  GCD->degFree);+         printf ("Chi2 statistic for GCD values         :");+         gofw_Writep2 (GCD->sVal2[gofw_Mean], GCD->pVal2[gofw_Mean]);+      } else {+         printf ("Test results for GCD values:\n");+         gofw_WriteActiveTests0 (N, GCD->sVal2, GCD->pVal2);+         swrite_Chi2SumTest (N, GCD);+      }+      /*+      if (swrite_Collectors)+         statcoll_Write (NumIter->sVal1, 5, 14, 4, 3);+      printf ("\n-----------------------------------------------\n");+      if (N == 1) {+         printf ("Number of degrees of freedom          : %4ld\n",+                  NumIter->degFree);+	 printf ("Chi2 statistic for NumIter            :");+	 gofw_Writep2 (NumIter->sVal2[gofw_Mean], NumIter->pVal2[gofw_Mean]);+      } else {+	 printf ("Test results for NumIter:\n");+	 gofw_WriteActiveTests0 (N, NumIter->sVal2, NumIter->pVal2);+         swrite_SumTest (N, NumIter->sVal2[gofw_Sum], NumIter->pVal2[gofw_Sum], +                         N*NumIter->degFree);+      }+      */+      printf ("\n\n");+      swrite_Final (gen, Timer);+   }++   if (localRes)+      smarsa_DeleteRes2 (res);+   chrono_Delete (Timer);++}+++/*=========================================================================*/
+ cbits/testu/src/smultin.c view
@@ -0,0 +1,3674 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           smultin.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/+++#include "util.h"+#include "chrono.h"+#include "num.h"+#include "num2.h"+#include "tables.h"++#include "smultin.h"+#include "wdist.h"+#include "swrite.h"+#include "unif01.h"++#include "statcoll.h"+#include "gofw.h"+#include "fmass.h"+#include "fdist.h"+#include "fbar.h"++#include <math.h>+#include <string.h>+#include <stdio.h>+#include <float.h>+++++++/*============================= constants ===============================*/++/* Max string length */+#define LENGTH 100++/* Max dimension t */+#define MAX_DIM 64++/* Used for secondary hashing */+#define HACHE2 41++/* Upper Limit of precomputed tables of 2nI, when SPARSE = TRUE */+static const long LIM_SPARSE = 64;++/* LIM_DENSE*n/k = upper limit of the precomputed tables for 2nI, when */+/* SPARSE = FALSE and 6n/k < k */+static const double LIM_DENSE = 6.0;++/* Precision with which we measure specific values of ValDelta */+static const double EPS_LAM = 1.0E-14;++#ifdef USE_LONGLONG+#define MAXK 9223372036854775808.0  /* 2^63 */+#else+#define MAXK 9007199254740992.0     /* 2^53 */+#endif++/* Our gamma distribution is not good for parameters larger than this. */+#define EMPTYLIM 200000000000000.0++#define MASK64  0x8000000000000000ULL  /* 2^63: set bit 64 to 1 */++#define TRACE(N)  printf ("*********   "#N"%13ld\n", N);++++/*=============================== Types =================================*/++/* Index for the different values of ValDelta */+typedef int DeltaIndex;+++++/*========================= Extern variables ============================*/++smultin_Envir smultin_env = {+   MAXK,+   1024 * 1024,                   /* SeuilHash */+   0.75,                          /* HashLoad */+   5.0E+6,                        /* SeuilEColl */++   12.0,                          /* SeuilCOverDense */+   5.0,                           /* SeuilCOverNorSup */+   1.999,                         /* SeuilCOverNorInf */+   1.0001                         /* SeuilCOverSparse */+};+++/* The stable parameters values used by default */+smultin_Param smultin_ParamDefault = {+   2,                             /* NbDelta */+   {-1, 1},                       /* ValDelta */+   smultin_GenerCellSerial,       /* GenerCell */+   -3                             /* bmax */+};++++/*============================== Functions ==============================*/+++smultin_Param *smultin_CreateParam (int NbDelta, double ValDelta[],+   smultin_GenerCellType GenerCell, int bmax)+{+   smultin_Param *par;+   int j;++   par = util_Malloc (sizeof (smultin_Param));+   par->NbDelta = NbDelta;+   for (j = 0; j < NbDelta; j++) {+      util_Assert (ValDelta[j] >= -1.0,+         "smultin_CreateParam:   ValDelta[j] < -1");+      par->ValDelta[j] = ValDelta[j];+   }+   util_Assert (bmax <= smultin_MAXB,+      "smultin_CreateParam:   bmax > smultin_MAXB");+   par->bmax = bmax;+   par->GenerCell = GenerCell;+   return par;+}++/*-------------------------------------------------------------------------*/++void smultin_DeleteParam (smultin_Param *par)+{+   if (par == NULL)+      return;+   util_Free (par);+}+++/*=========================================================================*/++static void CleanPD (smultin_Res *res)+{+   DeltaIndex s;++   if (res == NULL)+      return;++   for (s = 0; s < res->NbDeltaOld; s++) {+      res->TabFj[s] = util_Free (res->TabFj[s]);+   }++   res->Count = util_Free (res->Count);+   res->Count1 = util_Free (res->Count1);+   res->Cell = util_Free (res->Cell);+   res->Cell1 = util_Free (res->Cell1);+   res->Nb = util_Free (res->Nb);+   res->Nb1 = util_Free (res->Nb1);+}+++/*=========================================================================*/++static void InitRes (+   smultin_Param *par, +   smultin_Res *res,          /* Results holder */+   long N                     /* Number of replications */+)+/* + * Initializes the smultin_Res structure. The old NbDelta is in res, the+ * new NbDelta is in par. Delete the unused collectors if old NbDelta > new+ * NbDelta, and create the needed collectors if old NbDelta < new NbDelta.+ */+{+   DeltaIndex s;++   if (par == NULL)+      par = &smultin_ParamDefault;+   CleanPD (res);++   for (s = par->NbDelta; s < res->NbDeltaOld; s++)+      res->Collector[s] = statcoll_Delete (res->Collector[s]);++   for (s = res->NbDeltaOld; s < par->NbDelta; s++)+      res->Collector[s] = statcoll_Create (N, "");++   for (s = 0; s < par->NbDelta; s++) {+      statcoll_Init (res->Collector[s], N);+      gofw_InitTestArray (res->sVal2[s], -1.0);+      gofw_InitTestArray (res->pVal2[s], -1.0);+   }++   res->NbDeltaOld = par->NbDelta;+   res->flagTab = FALSE;+   res->nLimit = 1;+   res->pColl = res->pEmpty = -1.0;+   res->pCollLeft = -1.0;+   res->pCollRight = -1.0;+}+++/*-------------------------------------------------------------------------*/++smultin_Res * smultin_CreateRes (smultin_Param *par)+{+   smultin_Res *res;+   DeltaIndex s;++   res = util_Malloc (sizeof (smultin_Res));+   memset (res, 0, sizeof (smultin_Res));++   if (par == NULL)+      par = &smultin_ParamDefault;++   for (s = 0; s < par->NbDelta; s++) {+      res->Collector[s] = statcoll_Create (1, "");+      res->TabFj[s] = NULL;+   }++   res->Count = NULL;+   res->Count1 = NULL;+   res->Cell = NULL;+   res->Cell1 = NULL;+   res->NbDeltaOld = 0;+   res->Nb = NULL;+   res->Nb1 = NULL;++   return res;+}+++/*-------------------------------------------------------------------------*/++void smultin_DeleteRes (smultin_Res * res)+{+   DeltaIndex s;++   if (res == NULL)+      return;++   for (s = 0; s < res->NbDeltaOld; s++)+      res->Collector[s] = statcoll_Delete (res->Collector[s]);++   CleanPD (res);+   util_Free (res);+}+++/*=========================================================================*/++double smultin_MNTermeKhi2 (double junk, double NbEsp, long j)+/*+ * One term of Chi2 = 2nI1; there are j balls in this urn.+ */+{+   double Diff;+   Diff = j - NbEsp;+   return Diff * Diff / NbEsp;+}+++/*=======================================================================*/++double smultin_MNTermePowDiv (double Delta, double NbEsp, long j)+/*+ * One term of Power Divergence = 2nI; there are j balls in this urn.+ */+{+   double y;+   if (j == 0)+      return 0.0;+   y = pow (j / NbEsp, Delta) - 1.0;+   return (2.0 * j * y) / (Delta * (Delta + 1.0));+}+++/*=======================================================================*/++double smultin_MNTermeLogLikhood (double junk, double NbEsp, long j)+/*+ * One term of loglikelihood ratio = 2nI0; there are j balls in this urn+ */+{+   if (j == 0)+      return 0.0;+   return 2.0 * j * log (j / NbEsp);+}+++/*=======================================================================*/++double smultin_MNTermeColl (double junk1, double junk2, long j)+/*+ * Number of collisions when there are j balls in this urn+ */+{+   if (j <= 1)+      return 0.0;+   return (double) (j - 1);+}+++/*=======================================================================*/++static void MNCalcMuSigma (+   double V[],           /* Contains the terms of the statistic */+   long nlim,            /* Limit on the non negligible terms */+   long n,               /* Number of balls */+   double k,             /* Number of urns */+   double *Mu,           /* Mean */+   double *Sigma         /* Standard deviation */+   )+/*+ * Compute the mean Mu and the standard deviation Sigma. For some values+ * of n and k, some of the terms to be subtracted will be huge and loss+ * of precision may give negative variance. We shall then stop the tests+ * and exit in WriteDataPowDiv.+ */+{+   const double Epsilon = 1.0E-100;    /* To avoid division by 0 */+   const double Eps = 1.0E-18;+   long i, j, Mid;+   double cond2, cond1, temp;+   double Sum3, Sum2, Sum1;+   double muk, Var;+   double km;+   double Terme2, TermeMid, Terme1;+   double x, nr = n;++   util_Assert (nlim <= n, "MNCalcMuSigma;  nlim > n");+   Mid = n / k;+   while (Mid < nlim && fabs (V[Mid]) < Eps)+      ++Mid;+   util_Assert (Mid <= nlim, "MNCalcMuSigma;  Mid > nlim");++   /******* Compute Mean x = *Mu */+   TermeMid = fmass_BinomialTerm3 (n, 1.0 / k, Mid) * k;+   x = V[Mid] * TermeMid;+   Terme1 = x;+   i = Mid;+   km = k - 1;+   while (i < n && fabs (Terme1 / x) > Eps) {+      util_Assert (i < nlim, "MNCalcMuSigma: nlim too small --> Espion001");+      Terme1 *= V[i + 1] * (n - i) / (V[i] * (i + 1) * km);+      x += Terme1;+      ++i;+   }+   Terme1 = V[Mid] * TermeMid;+   i = Mid;+   while (i > 0 && fabs (Terme1) / x > Eps) {+      Terme1 *= V[i - 1] * i * km / (V[i] * (n - i + 1));+      x += Terme1;+      --i;+   }+   /* The cases when |Terme[i]| < Eps, but |Terme[i-1]| > Eps */+   /* these terms must be included also. */+   --i;+   if (i >= 0) {+      Terme1 = V[i] * fmass_BinomialTerm3 (n, 1.0 / k, i) * k;+      x += Terme1;+      while (i > 0 && fabs (Terme1 / x) > Eps) {+         Terme1 = Terme1 * V[i - 1] * i * km / (V[i] * (n - i + 1));+         x += Terme1;+         --i;+      }+   }++   /****** Calculate variance: first series of terms */+   muk = x / k;+   Terme1 = (V[Mid] - muk) * (V[Mid] - muk) * TermeMid;+   cond2 = TermeMid * V[Mid] * V[Mid];+   Sum1 = Terme1;+   Terme2 = Terme1;+   i = Mid;+   km = k - 1;+   while (i < n && fabs (cond2 / Sum1) + fabs (Terme2 / Sum1) > Eps) {+      util_Assert (i < nlim, "MNCalcMuSigma: nlim too small --> Espion002");+      temp = V[i + 1] / (V[i] + Epsilon);+      cond2 *= temp * temp * (n - i) / ((i + 1) * km);+      temp = (V[i + 1] - muk) / (V[i] - muk);+      Terme2 *= temp * temp * (n - i) / ((i + 1) * km);+      Sum1 += Terme2;+      ++i;+   }+   Terme2 = Terme1;+   cond2 = TermeMid * V[Mid] * V[Mid];+   i = Mid;+   while (i > 0 && fabs (cond2 / Sum1) + fabs (Terme2 / Sum1) > Eps) {+      temp = V[i - 1] / (V[i] + Epsilon);+      cond2 *= temp * temp * i * km / (n - i + 1);+      temp = (V[i - 1] - muk) / (V[i] - muk);+      Terme2 *= temp * temp * i * km / (n - i + 1);+      Sum1 += Terme2;+      --i;+   }++   /****** Calculate variance: terms i = j */+   temp = fmass_BinomialTerm4 (n - Mid, 1.0 / k, 2.0 / k, Mid) *+      fmass_BinomialTerm4 (n, 1.0 / k, 0.0, Mid) * k * (k - 1);+   TermeMid = temp * (V[Mid] - muk) * (V[Mid] - muk);+   cond1 = TermeMid * V[Mid] * V[Mid] +             / ((V[Mid] - muk) * (V[Mid] - muk) + Epsilon);+   Terme1 = TermeMid;+   Sum2 = Terme1;+   i = Mid;+   km = k - 2;+   while ((i < n / 2)+      && fabs (cond1 / Sum2) + fabs (Terme1 / Sum2) > Eps) {+      util_Assert (i < nlim, "MNCalcMuSigma: nlim too small --> Espion003");+      temp = V[i + 1] / ((V[i] + Epsilon) * (i + 1) * km);+      cond1 *= (nr - 2 * i) * (nr - 2 * i - 1) * temp * temp;+      temp = (V[i + 1] - muk) / ((V[i] - muk) * (i + 1) * km);+      Terme1 *= (nr - 2 * i) * (nr - 2 * i - 1) * temp * temp;+      Sum2 += Terme1;+      ++i;+   }+   i = Mid;+   Terme1 = TermeMid;+   cond1 = TermeMid * V[Mid] * V[Mid] / ((V[Mid] - muk) * (V[Mid] - muk));+   while (i > 0 && fabs (cond1 / Sum2) + fabs (Terme1 / Sum2) > Eps) {+      temp = (V[i - 1] * i * km) / (V[i] + Epsilon);+      cond1 *= temp * temp / ((nr - 2 * i + 2) * (nr - 2 * i + 1) + Epsilon);+      temp = (V[i - 1] - muk) * i * km / (V[i] - muk);+      Terme1 *= temp * temp / ((nr - 2 * i + 2) * (nr - 2 * i + 1) + Epsilon);+      Sum2 += Terme1;+      --i;+   }+   /****** Calculate variance: terms i <> j */+   i = Mid + 1;+   Sum3 = 1.0E-40;+   cond1 = 1.0;+   Terme1 = 1.0;+   while (i <= n && fabs (cond1 / Sum3) + fabs (Terme1 / Sum3) > Eps) {+      util_Assert (i <= nlim, "MNCalcMuSigma: nlim too small --> Espion004");+      j = Mid;+      if (j > n - i)+         j = n - i;+      temp = fmass_BinomialTerm4 (n, 1.0 / k, 0.0, i) *+         fmass_BinomialTerm4 (n - i, 1.0 / k, 2.0 / k, j);+      Terme1 = temp * (V[i] - muk) * (V[j] - muk) * k * (k - 1);+      cond1 = Terme1 * V[i] * V[j] / ((V[i] - muk) * (V[j] - muk));+      Sum3 += Terme1;+      Terme2 = Terme1;+      cond2 = cond1;+      while (j > 0 && fabs (cond2 / Sum3) + fabs (Terme2 / Sum3) > Eps) {+         cond2 *= V[j - 1] * j * km / (V[j] * (n - i - j + 1) + Epsilon);+         Terme2 *= (V[j - 1] - muk) * j * km /+                    ((V[j] - muk) * (n - i - j + 1) + Epsilon);+         Sum3 += Terme2;+         --j;+      }+      Terme2 = Terme1;+      cond2 = cond1;+      j = Mid;+      while ((j < i - 1 && i + j < n)+         && fabs (cond2 / Sum3) + fabs (Terme2 / Sum3) > Eps) {+         util_Assert (j < nlim, "MNCalcMuSigma: nlim too small --> Espion005");+         cond2 *= V[j + 1] * (n - i - j) / (V[j] * (j + 1) * km + Epsilon);+         Terme2 *= (V[j + 1] - muk) * (n - i - j)+                     / ((V[j] - muk) * (j + 1) * km + Epsilon);+         Sum3 += Terme2;+         ++j;+      }+      ++i;+   }+   i = Mid;+   cond1 = Sum3 + 1.0;+   Terme1 = 1.0;+   while (i > 0 && fabs (cond1 / Sum3) + fabs (Terme1 / Sum3) > Eps) {+      j = i - 1;+      temp = fmass_BinomialTerm4 (n, 1.0 / k, 0.0, i) *+         fmass_BinomialTerm4 (n - i, 1.0 / k, 2.0 / k, j);+      Terme1 = temp * (V[i] - muk) * (V[j] - muk) * k * (k - 1.0);+      cond1 = (Terme1 * V[i] * V[j]) / ((V[i] - muk) * (V[j] - muk));+      Sum3 += Terme1;+      Terme2 = Terme1;+      cond2 = cond1;+      while (j > 0 && fabs (cond2 / Sum3) + fabs (Terme2 / Sum3) > Eps) {+         cond2 *= V[j - 1] * j * km / (V[j] * (n - i - j + 1) + Epsilon);+         Terme2 *= (V[j - 1] - muk) * j * km /+                       ((V[j] - muk) * (n - i - j + 1) + Epsilon);+         Sum3 += Terme2;+         --j;+      }+      --i;+   }+   Var = Sum1 + Sum2 + 2.0 * Sum3;+   util_Warning (Var < 0.0, "MNCalcMuSigma:   negative variance");+   if (Var >= 0.0)+      *Sigma = sqrt (Var);+   else+      *Sigma = -1.0;+   *Mu = x;+}+++/*=======================================================================*/++void smultin_MultinomMuSigma (+   long n,                    /* Number of balls */+   double k,                  /* Number of urns */+   double Theta1,             /* First parameter of the term F */+   double Theta2,             /* Second parameter of the term F */+   smultin_MNTermeType F,     /* One term of the statistic */+   double *Mu,                /* Mean */+   double *Sigma              /* Standard deviation */+   )+/*+ * Compute the mean Mu and the standard deviation Sigma+ */+{++   /* For densities n/k < 8, only the ~ 25 first terms will contribute */+   /* significantly to the normal approximation; thus we precompute only */+   /* elements [0..LIM_SPARSE] of the tables in the case Sparse = TRUE */++   long nlim;+   long j;+   double densite;+   double *PV;++   /* We may choose n >>> nlim because the probabilities will be concen- */+   /* trated near j = 0 for low densites ( < 8). Large values of j will  */+   /* practically never occur. It is not necessary to compute all the    */+   /* PV[0..n]. For high densities n/k, nlim will have to be increased.  */++   densite = n / (double) k;+   nlim = 8 * densite;+   if (nlim < LIM_SPARSE)+      nlim = LIM_SPARSE;          /* Sparse = TRUE */+   if (nlim > n)+      nlim = n;                   /* Sparse = FALSE */+   PV = util_Calloc ((size_t) nlim + 2, sizeof (double));+   for (j = 0; j <= nlim; j++)+      PV[j] = F (Theta1, Theta2, j);+   MNCalcMuSigma (PV, nlim, n, k, Mu, Sigma);+   util_Free (PV);+}+++/*=======================================================================*/++static void CalcTabFj (+   smultin_Param *par,+   smultin_Res *res,+   lebool Sparse,+   double k,                  /* Number of cells or urns */+   double NbExp               /* Expected number per cell */+   )+/*+ * May pre-calculate all terms. Will then calculate all non negligible+ * terms for all values of s, and keep them in tables TabFj[s][].+ */+{+   long i;+   DeltaIndex s;+   double delta;+   double c;+   double temp;+   double *F;++   if (!Sparse && LIM_DENSE * NbExp > k) {+      /* Do not precompute tables when Sparse = FALSE and we have a very */+      /* small number k of cells */+      res->flagTab = FALSE;+      return;+   }++   /* Precompute the values and keep them in arrays */+   res->flagTab = TRUE;+   if (Sparse)+      res->nLimit = LIM_SPARSE;+   else {+      res->nLimit = LIM_DENSE * NbExp;+      if (res->nLimit < 1)+         res->nLimit = 2;+   }++   for (s = 0; s < par->NbDelta; s++) {+      res->TabFj[s] = util_Calloc (2 + (size_t) res->nLimit, sizeof (double));+      delta = par->ValDelta[s];+      util_Assert (delta >= -1.0 - EPS_LAM,+         "CalcTabFj:   par->ValDelta[s] < -1");+      F = res->TabFj[s];+      F[0] = 0.0;++      if (fabs (delta - 1.0) < EPS_LAM) {+         /* ChiSquare */+         for (i = 0; i <= res->nLimit; i++) {+            temp = i - NbExp;+            F[i] = temp * temp / NbExp;+         }++      } else if (fabs (delta) < EPS_LAM) {+         /* LogLikelyhood */+         for (i = 1; i <= res->nLimit; i++) {+            temp = i;+            F[i] = 2.0 * temp * log (temp / NbExp);+         }++      } else if (fabs (delta + 1.0) < EPS_LAM) {+         /* Collision */+         for (i = 1; i <= res->nLimit; i++) {+            F[i] = i - 1;+         }++      } else {+         /* PowerDivergence, delta > -1 */+         c = 2.0 / (delta * (delta + 1.0));+         for (i = 1; i <= res->nLimit; i++) {+            temp = i;+            F[i] = c * temp * (pow (temp / NbExp, delta) - 1.0);+         }+      }+   }+}+++/*=======================================================================*/++static void ReCalcTabFj (+   smultin_Param *par,+   smultin_Res *res,+   double NbExp              /* Expected number per cell */+   )+/*+ * Update tables TabFj when one of the Count becomes larger than res->nLimit+ */+{+   long i;+   DeltaIndex s;+   double delta;+   double c;+   double temp;+   double *F;+   long i0 = res->nLimit;+   res->nLimit *= 2;++   for (s = 0; s < par->NbDelta; s++) {+      delta = par->ValDelta[s];+      res->TabFj[s] = util_Realloc (res->TabFj[s],+         (res->nLimit + 1) * sizeof (double));+      F = res->TabFj[s];++      if (fabs (delta - 1.0) < EPS_LAM) {+         /* ChiSquare */+         for (i = i0 + 1; i <= res->nLimit; i++) {+            temp = i - NbExp;+            F[i] = temp * temp / NbExp;+         }++      } else if (fabs (delta) < EPS_LAM) {+         /* LogLikelyhood */+         for (i = i0 + 1; i <= res->nLimit; i++) {+            temp = i;+            F[i] = 2.0 * temp * log (temp / NbExp);+         }++      } else if (fabs (delta + 1.0) < EPS_LAM) {+         /* Collision Test */+         for (i = i0 + 1; i <= res->nLimit; i++) {+            F[i] = i - 1;+         }++      } else {+         c = 2.0 / (delta * (delta + 1.0));+         for (i = i0 + 1; i <= res->nLimit; i++) {+            temp = i;+            F[i] = c * temp * (pow (temp / NbExp, delta) - 1.0);+         }+      }+   }+}+++/*=======================================================================*/++void smultin_PowDivMomCorChi (+   double Delta,+   long n,                    /* Number of balls */+   double k,                  /* Number of urns */+   double *MuC,               /* Corrected mean */+   double *SigmaC             /* Corrected standard deviation */+   )+/*+ * Compute the corrected mean and standard deviation in the dense case+ *  for the ChiSquare approximation. (See Read and Cressie)+ */+{+   double t = k * k;+   double temp;+   if (Delta < EPS_LAM - 1.0) {+      *MuC = -1.0;+      *SigmaC = -1.0;+      return;+   }+   temp = (8.0 - 12.0 * k - 2.0 * k * k + 6.0 * t ++      (Delta - 1.0) * (4.0 - 6.0 * k - 3.0 * k * k + 5.0 * t) / 3.0+      + 2.0 * (Delta - 2.0) * (1.0 - 2.0 * k + t));+   *SigmaC = 2.0 - 2.0 * k - (double) k * k + t + (Delta - 1.0) * temp;+   *SigmaC = sqrt (1.0 + *SigmaC / (2.0 * n * (k - 1.0)));+   temp = (2.0 - 3.0 * k + t) / 3.0 ++      (Delta - 2.0) * (1.0 - 2.0 * k + t) / 4.0;+   *MuC = (k - 1.0) * (1.0 - *SigmaC) + (Delta - 1.0) * temp / n;+}+++/*=======================================================================*/++void smultin_PowDivMom (+   double Delta,              /* Which Power Divergence */+   long n,                    /* Number of balls */+   double k,                  /* Number of urns */+   double NbExp,              /* Expected number per urn */+   double *Mu,                /* Mean */+   double *Sigma              /* Standard deviation */+   )+/*+ * Compute the mean and standard deviation in the sparse case+ */+{++   if ((double) n / k > 8.0) {+      printf ("*************  Call of smultin_PowDivMom with n/k > 8\n");+      *Mu = -1.0;+      *Sigma = -1.0;+      return;+   }+   if (k <= 2) {+      printf ("*************  Call of smultin_PowDivMom with k <= 2\n");+      *Mu = -1.0;+      *Sigma = -1.0;+      return;+   }++   util_Assert ((double) n / k <= 8.0,+      "smultin: Call of PowDivMom with n/k > 8");+   util_Assert (k > 2, "smultin: Call of PowDivMom with k <= 2");++   if (fabs (Delta - 1.0) < EPS_LAM) {+      /* ChiSquare test */+      *Mu = k - 1;+      *Sigma = sqrt (2.0 * (k - 1) * (n - 1.0) / n);++   } else if (fabs (Delta + 1.0) < EPS_LAM) {+      /* Collision test */+      smultin_MultinomMuSigma (n, k, 0.0, 0.0, smultin_MNTermeColl, Mu, Sigma);++   } else if (fabs (Delta) < EPS_LAM) {+      /* Delta = 0, LogLikelyhood */+      smultin_MultinomMuSigma (n, k, 0.0, NbExp, smultin_MNTermeLogLikhood,+                               Mu, Sigma);++   } else if (Delta > -1.0) {+      smultin_MultinomMuSigma (n, k, Delta, NbExp, smultin_MNTermePowDiv,+                               Mu, Sigma);++   } else+      util_Error ("smultin_PowDivMom:   Delta < -1.0");+}+++/*=======================================================================*/+#if 0++static void CalcPowDiv (double Delta, double NbExp[], long Count[],+   long smin, long smax, double *X)+/*+ * Compute the statistic $2n I^\delta$ defined in (\ref{powdiv}),+ * for $\delta = {\tt Delta}$, and return its value in $X$.+ * We assume that the expected values $n p_i$ in cell $i$  are in+ * {\tt NbExp[smin..smax]}, the observed values $X_i$ are in+ * {\tt Count[smin..smax]}, {\tt smin} and  {\tt smax} are the indices + * of the first and the last cell,+ * and the number of cells is $k = {\tt smax} - {\tt smin} + 1$.+ * The $p_i$ are not necessarily equal.+ */+{+   double temp;+   long s;+   *X = 0.0;++   if (fabs (Delta - 1.0) < EPS_LAM) {+      /* ChiSquare */+      for (s = smin; s <= smax; s++) {+         temp = Count[s] - NbExp[s];+         *X += (temp * temp) / NbExp[s];+      }++   } else if (fabs (Delta) < EPS_LAM) {+      /* Loglikelihood */+      for (s = smin; s <= smax; s++) {+         if (Count[s] > 0) {+            temp = Count[s];+            *X += temp * log (temp / NbExp[s]);+         }+      }+      *X *= 2.0;++   } else if (Delta <= EPS_LAM - 1.0) {+      util_Error ("smultin_CalcPowDiv:   Delta <= -1.0");+      /* We do the collisions test only when probabilities are equal. See+         smultin_CalcPowDivEqual. */++   } else {+      /* Other values of Delta.  */+      for (s = smin; s <= smax; s++) {+         if (Count[s] > 0) {+            temp = Count[s];+            *X += temp * (pow (temp / NbExp[s], Delta) - 1.0);+         }+      }+      *X = 2.0 * *X / (Delta * (Delta + 1.0));+   }+}++#endif++/*=======================================================================*/++static void CalcPowDivEqual (+   smultin_Param *par,+   smultin_Res *res,+   DeltaIndex s,+   double NbExp,                  /* Expected number per cell */+   long Count[],                  /* Counters */+   long jmin,                     /* First cell */+   long jmax,                     /* Last cell */+   lebool flagTab,                /* TRUE: use precomputed table */+   double *X                      /* Computed statistic */+   )+/*+ * This function is called only when we do not use hashing.+ *+ * As in CalcPowDiv, except that the values of np_i are all equal to+ * np = NbExp. The lebool flagTab indicates if the values of+ * $2 i ln (i/np)$ and+ * $ {2\over \delta(1+\delta)}+ *   i \left[\left(i/np\right)^\delta -1\right]$ have already been+ * pre-computed and kept in the arrays+ * F (it is so if {\tt flagTab = TRUE}).+ */+{+   double temp;+   double *F = res->TabFj[s];     /* The precomputed table */+   double Delta = par->ValDelta[s];+   long j;+   *X = 0.0;++   if (flagTab) {+      /* For low densities, we use precomputed tables since the observed */+      /* values will all be very small. We shall thus need only a few */+      /* terms (expensive to compute) of the statistics. */+      util_Assert (res->nLimit > 0,+         "smultin_CalcPowDivEqual BUG: res->nLimit <= 0");++      for (j = jmin; j <= jmax; j++) {+         /* A larger than expected counter needs terms that have not been */+         /* precomputed: Recompute missing terms. */+         while (Count[j] > res->nLimit) {+            ReCalcTabFj (par, res, NbExp);+            F = res->TabFj[s];+         }+         *X += F[Count[j]];+      }+      return;+   }++   /* High densities: no precomputed tables */+   if (fabs (Delta - 1.0) < EPS_LAM) {+      /* ChiSquare: Delta = 1 */+      for (j = jmin; j <= jmax; j++) {+         temp = Count[j] - NbExp;+         *X += temp * temp;+      }+      *X /= NbExp;++   } else if (fabs (Delta) < EPS_LAM) {+      /* Loglikelihood ratio */+      for (j = jmin; j <= jmax; j++) {+         if (Count[j] > 0) {+            temp = Count[j];+            *X += temp * log (temp / NbExp);+         }+      }+      *X *= 2.0;++   } else if (fabs (Delta + 1.0) < EPS_LAM) {+      /* Collision test */+      for (j = jmin; j <= jmax; j++) {+         if (Count[j] > 1)+            *X += Count[j] - 1;+      }++   } else if (Delta > (-1.0)) {+      for (j = jmin; j <= jmax; j++) {+         if (Count[j] > 0) {+            temp = Count[j];+            *X += temp * (pow (temp / NbExp, Delta) - 1.0);+         }+      }+      *X = (2.0 * *X) / (Delta * (Delta + 1.0));++   } else+      util_Error ("smultin_CalcPowDivEqual: Delta < -1");+}+++/*=======================================================================*/++static void CalcPoDiEqHache (+   smultin_Param *par,+   smultin_Res *res, +   DeltaIndex i,+   double NbExp,              /* Expected number per cell */+   smultin_CellType Nb[],     /* Number of cells with s balls */+   long CountMax,             /* Max number of balls in any cell */+   lebool flagTab,           /* TRUE if use precomputed table */+   double *X                  /* Computed statistic */+   )+/*+ * Compute the Power Divergence statistic or the number of collisions in + * the sparse case. We use a hashing table of smultin_CellType.+ */+{+   double temp;+   double *F = res->TabFj[i];     /* The precomputed table */+   double Delta = par->ValDelta[i];+   long s;+   *X = 0.0;++   if (flagTab) {+      /* For low densities, we use precomputed tables since the observed */+      /* values will all be very small. We shall thus need only a few */+      /* terms (expensive to compute) of the statistics. */+      util_Assert (res->nLimit > 0, "CalcPoDiEqHache BUG: res->nLimit <= 0");++      /* A larger than expected counter needs terms that have not been */+      /* precomputed: Recompute missing terms. */+      while (CountMax > res->nLimit) {+         ReCalcTabFj (par, res, NbExp);+         F = res->TabFj[i];+      }++      for (s = 0; s <= CountMax; s++) {+         *X += F[s] * Nb[s];+      }+      return;+   }++   /* High densities: no precomputed tables */+   if (fabs (Delta - 1.0) < EPS_LAM) {+      /* ChiSquare: Delta = 1 */+      for (s = 1; s <= CountMax; s++) {+         temp = s - NbExp;+         *X += temp * temp * Nb[s];+      }+      *X = *X / NbExp + NbExp * Nb[0];++   } else if (fabs (Delta) < EPS_LAM) {+      /* Delta = 0: Loglikelihood ratio */+      for (s = 1; s <= CountMax; s++) {+         temp = s;+         *X += temp * log (temp / NbExp) * Nb[s];+      }+      *X *= 2.0;++   } else if (fabs (Delta + 1.0) < EPS_LAM) {+      /* Collision test */+      for (s = 2; s <= CountMax; s++) {+         *X += (s - 1.0) * Nb[s];+      }++   } else if (Delta > -1.0) {+      for (s = 1; s <= CountMax; s++) {+         temp = s;+         *X += temp * (pow (temp / NbExp, Delta) - 1.0) * Nb[s];+      }+      *X = 2.0 * *X / (Delta * (Delta + 1.0));++   } else+      util_Error ("CalcPoDiEqHache: Delta < -1");+}+++/*=======================================================================*/++static void CalcNbCells (+   smultin_Param *par,+   smultin_Res *res,+   long jmin,                 /* First cell */+   long jmax,                 /* Last cell */+   long CoMax                 /* Maximum number of balls in any cell */+   )+/*+ * Compute the number of cells containing j balls or more.+ */+{++   long j;+   smultin_CellType wb[smultin_MAXB + 1];+   long *Count = res->Count;      /* Counters */+   smultin_CellType *Nb = res->Nb; /* Nb[j] = number of cells with j balls */++   util_Assert (par->bmax <= smultin_MAXB,+      "CalcNbCells:   smultin_MAXB is too small");++   for (j = 0; j <= smultin_MAXB; j++)+      wb[j] = 0;++   if (res->Hashing) {+      for (j = smultin_MAXB; j <= CoMax; j++)+         wb[smultin_MAXB] += Nb[j];+      for (j = smultin_MAXB - 1; j >= 0; j--)+         wb[j] = wb[j + 1] + Nb[j];++   } else {+      Nb[0] = 0;+      for (j = jmin; j <= jmax; j++) {+         if (Count[j] > smultin_MAXB) {+            wb[smultin_MAXB] += 1;+         } else+            Nb[Count[j]] += 1;+      }+      wb[smultin_MAXB] += Nb[smultin_MAXB];+      for (j = smultin_MAXB - 1; j >= 0; j--)+         wb[j] = wb[j + 1] + Nb[j];+   }++   /* the local array wb is necessary in the case N > 1 and Poisson since */+   /* then, the statistic used is the sum of the N  Poisson statistics;   */+   /* we are here summing the numbers for the N replications of the test. */++   for (j = 0; j <= smultin_MAXB; j++) {+      res->WbCells[j] += wb[j];+      res->NbCells[j] += Nb[j];+   }+}+++/*=======================================================================*/++smultin_CellType smultin_GenerCellSerial (unif01_Gen *gen,+    int r, int t, long d)+{+   int j;+   smultin_CellType dr = d;+   smultin_CellType Cell;++   Cell = unif01_StripL (gen, r, d);+   for (j = 2; j <= t; j++)+      Cell = Cell * dr + unif01_StripL (gen, r, d);+   return Cell;+}+++/*=======================================================================*/++smultin_CellType smultin_GenerCellSerial2 (unif01_Gen *gen,+   int r, int t, long d)+{+   int j;+   smultin_CellType dr = d;+   smultin_CellType Cell;++   Cell = unif01_StripL (gen, r, d);+   for (j = 2; j <= t; j++) {+      Cell += dr * unif01_StripL (gen, r, d);+      dr *= d;+   }+   return Cell;+}+++/*=======================================================================*/++smultin_CellType smultin_GenerCellPermut (unif01_Gen *gen,+   int r, int t, long junk)+{+   int s, i, j;+   smultin_CellType Cell = 0;+   double U[64];++   for (j = 1; j <= t; j++)+      U[j] = unif01_StripD (gen, r);++   for (i = t; i >= 2; i--) {+      /* Find the U[s] = max (U[1],...,U[i]) */+      s = 1;+      for (j = 2; j <= i; j++) {+         if (U[j] > U[s])+            s = j;+      }+      Cell = Cell * i + (s - 1);+      U[s] = U[i];+   }+   return Cell;+}+++/*=======================================================================*/++smultin_CellType smultin_GenerCellMax (unif01_Gen *gen,+   int r, int t, long junk)+{+   int i, MaxI;+   double U, MaxU = -1.0;++   /* Don't forget that cells are numbered from 0 to k - 1 */+   for (i = 0; i < t; i++) {+      U = unif01_StripD (gen, r);+      if (U > MaxU) {+         MaxU = U;+         MaxI = i;+      }+   }+   return (smultin_CellType) MaxI;+}+++/*=======================================================================*/++smultin_CellType smultin_GenerCellSerialBits (unif01_Gen * gen,+   int r, int s, long L)+{+   const int t = L / s;+   const smultin_CellType dr = num_TwoExp[s];+   smultin_CellType Cell;+   int j;++   Cell = unif01_StripB (gen, r, s);+   for (j = 2; j <= t; j++)+      Cell = Cell * dr + unif01_StripB (gen, r, s);+   return Cell;+}+++/*=======================================================================*/++fmass_INFO smultin_CreateCollisions (long n, smultin_CellType k)+{+   const long nLim = 100000;+   const int MaxIter = 32;+   const double Epsilon = DBL_EPSILON;+   const double DensityLim = 1.0001;+   long J1, J0, j, i, Dim;+   double terme, v, u, mu, sigma, x;+   double kinv = 1.0 / k;+   double *A;+   fmass_INFO W;++   util_Assert (k > 0, "smultin_CreateCollisions:  k <= 0");+   util_Assert (n > 0, "smultin_CreateCollisions:  n <= 0");++   /* Poisson Approximation */+   if ((n > nLim) && ((double) n / k <= DensityLim)) {+      if ((double) n / k <= 0.1) {+         int jj;+         /* To avoid loss of precision when n/k --> 0, we expand the */+         /* formula below in a MacLaurin series */++         jj = 3;+         u = n - 1;+         v = 2.0;+         terme = (n * u) / (2.0 * k * k);+         mu = terme;+         while (fabs (terme / mu) > Epsilon && jj < MaxIter) {+            u -= 1.0;+            v += 1.0;+            terme = -terme * u / (k * v);+            mu += terme;+            ++jj;+         }+         util_Assert (jj < MaxIter,+                      "smultin_CreateCollisions: limit MaxIter hit");++      } else if (n <= 100) {+         mu = ((double) n / k - 1.0) + pow (1.0 - 1.0 / k, (double) n);++      } else {+         const int ITER = 10;+         int i;+         terme = kinv;+         mu = terme;++         /* Compute the log of pow(1 - 1/k, n) by Maclaurin series */+         for (i = 2; i < ITER; i++) {+            terme *= kinv;+            mu += terme / i;+         }+         mu = ((double) n / k - 1.0) + exp (-n * mu);+      }++      mu *= k;+      W = fmass_CreatePoisson (mu);+      /* W->paramR[0] now contains the Poisson parameter mu */+      W->paramR = util_Realloc (W->paramR, 3 * sizeof (double));+      W->paramR[1] = n;+      W->paramR[2] = k;+      W->paramI = util_Malloc (sizeof (long));+      W->paramI[0] = smultin_CollPoissonSparse;+      return W;+   }++   W = util_Malloc (sizeof (struct fmass_INFO_T));+   W->paramI = util_Malloc (sizeof (long));+   W->paramR = util_Calloc (5, sizeof (double));+   W->paramR[1] = n;+   W->paramR[2] = k;+++   /* Normal Approximation */+   if (n > nLim) {+      smultin_MultinomMuSigma (n, (double) k, 0.0, 0.0, smultin_MNTermeColl,+                               &mu, &sigma);+      W->paramR[3] = mu;+      W->paramR[4] = sigma;+      W->paramI[0] = smultin_CollNormal;+      W->pdf = NULL;+      W->cdf = NULL;+      W->smin = -1;+      W->smax = -1;+      return W;+   }+++   /* Exact Distribution */+   A = util_Calloc ((size_t) n + 2, sizeof (double));+   for (j = 0; j <= n; j++)+      A[j] = 0.0;+   A[1] = 1.0;+   J1 = J0 = 1;+   for (j = 1; j <= n - 1; j++) {+      ++J1;+      i = J1;+      while (i >= J0) {+         x = i * kinv;+         A[i] = x * A[i] + (1.0 + kinv - x) * A[i - 1];+         if (A[i] <= Epsilon) {+            A[i] = 0.0;+            if (i == J1)+               --J1;+            else if (i == J0)+               ++J0;+         }+         --i;+      }+   }+   Dim = n - J0 + 1;+   W->pdf = util_Calloc ((size_t) Dim + 1, sizeof (double));+   W->cdf = util_Calloc ((size_t) Dim + 1, sizeof (double));++   W->pdf[0] = A[n];+   W->cdf[0] = A[n];+   j = 0;+   while (j < Dim && W->cdf[j] < 1.0) {+      ++j;+      W->pdf[j] = A[n - j];+      W->cdf[j] = W->pdf[j] + W->cdf[j - 1];+   }+   while (j <= Dim) {+      W->pdf[j] = A[n - j];+      W->cdf[j] = 1.0;+      ++j;+   }+   util_Free (A);+   W->paramI[0] = smultin_CollExact;+   W->smin = 0;+   W->smax = Dim;+   return W;+}+++/*-------------------------------------------------------------------------*/++void smultin_DeleteCollisions (fmass_INFO W)+{+   if (W == NULL)+      return;+   util_Free (W->paramI);+   util_Free (W->paramR);+   util_Free (W->pdf);+   util_Free (W->cdf);+   util_Free (W);+}+++/*-------------------------------------------------------------------------*/++double smultin_CollisionsTerm (fmass_INFO W, long s)+{+   int par;+   double z;+   double Mu;+   double Sigma;++   util_Assert (W != NULL,+      "smultin_CollisionsTerm:   fmass_INFO is NULL pointer");+   if (s < 0)+      return 0.0;+   par = W->paramI[0];++   switch (par) {+   case smultin_CollPoissonSparse:+      return fmass_PoissonTerm2 (W, s);+   case smultin_CollNormal:+      Mu = W->paramR[3];+      Sigma = W->paramR[4];+      z =  fdist_Normal2 ((s - Mu) / Sigma) -+           fdist_Normal2 ((s - 1 - Mu) / Sigma);+      return z;+   case smultin_CollExact:+      if (s > W->smax)+         return 0.0;+      return W->pdf[s];+   default:+      util_Error ("smultin_CollisionsTerm:  Not initialized");+      return 0.0;+   }+}+++/*-------------------------------------------------------------------------*/++double smultin_FDistCollisions (fmass_INFO W, long s)+{+   int par;++   util_Assert (W != NULL,+      "smultin_FDistCollisions: fmass_INFO is NULL pointer");+   if (s < 0)+      return 0.0;+   par = W->paramI[0];++   switch (par) {+   case smultin_CollPoissonSparse:+      return fdist_Poisson2 (W, s);+   case smultin_CollNormal:+      /* W->paramR[3] = Mu, W->paramR[4] = Sigma */+      return fdist_Normal2 ((s - W->paramR[3]) / W->paramR[4]);+   case smultin_CollExact:+      if (s > W->smax)+         return 1.0;+      return W->cdf[s];+   default:+      util_Error ("smultin_FDistCollisions:  Not initialized");+      return 0.0;+   }+}+++/*-------------------------------------------------------------------------*/++double smultin_FBarCollisions (fmass_INFO W, long s)+{+   return 1.0 - smultin_FDistCollisions (W, s - 1);+}+++/*=======================================================================*/++static void InitPowDiv (+   smultin_Param *par,+   smultin_Res *res,+   long N,                    /* Number of replications */+   lebool Sparse,+   long n,                    /* Number of balls */+   smultin_CellType z         /* Number of urns (not quite for PowDivOver) */+   )+/*+ * Initialize the multinomial tests+ */+{++   DeltaIndex s;+   long j;+   double NbExp;+   char chaine[LENGTH + 1];+   char Str[LENGTH + 1];+   double Mu;                     /* Mean */+   double Sigma;                  /* Standard Deviation */++   NbExp = (double) n / z;+   if (z >= smultin_env.SeuilHash && NbExp < 1.0)+      res->Hashing = TRUE;+   else+      res->Hashing = FALSE;++   res->EsCells[0] = N * (double) z * exp (-NbExp);+   res->EsEmpty = res->EsCells[0];+   res->NbCells[0] = 0;+   res->WbCells[0] = 0;++   util_Assert (par->NbDelta <= smultin_MAX_DELTA,+      "par->NbDelta > smultin_MAX_DELTA");+   for (s = 0; s < par->NbDelta; s++) {++      if (Sparse) {+         smultin_PowDivMom (par->ValDelta[s], n, (double) z, (double) n / z,+            &Mu, &Sigma);++      } else if (fabs (par->ValDelta[s] + 1.0) > EPS_LAM) {+         /* Non collision tests */+         smultin_PowDivMomCorChi (par->ValDelta[s], n, (double) z, &Mu,+            &Sigma);++      } else {+         /* Meaningless values as flags */+         Mu = -1.0;+         Sigma = -1.0;+      }+      res->Mu[s] = Mu;+      res->Sigma[s] = Sigma;++      if (fabs (par->ValDelta[s] + 1.0) < EPS_LAM) {+         /* Collision test */+         strncpy (Str, "The N statistic values for Collision:", (size_t) 64);+         res->NbCollisions = 0.0;+         for (j = 1; j <= smultin_MAXB; j++) {+            res->NbCells[j] = 0;+            res->WbCells[j] = 0;+         }+         /* The exact expected numbers (from Knuth)+             temp = n * log ((z - 1.0)/z);+             res->EsCells[0] = z * exp (temp);+             res->EsCells[1] = n * res->EsCells[0] / (z - 1.0);+             res->EsCells[2] = (n - 1.0) * res->EsCells[1] / (2.0*(z - 1.0));+             res->EsCells[>=3] = z - res->EsCells[0] - res->EsCells[1] -+                                  res->EsCells[2];+         */++         /* Expected numbers of urns with exactly j balls in the Poisson */+         /* approximation */+         for (j = 1; j <= smultin_MAXB; j++) {+            res->EsCells[j] = (res->EsEmpty * pow (NbExp, (double) j))+               / num2_Factorial (j);+         }+         /* Expected numbers of urns with >= j balls */+         for (j = smultin_MAXB - 1; j >= 0; j--) {+            res->EsCells[j] += res->EsCells[j + 1];+         }++      } else {+         /* Non Collision tests */+         strncpy (Str, "The N statistic values for Delta = ", (size_t) 64);+         sprintf (chaine, "%4.2f:", par->ValDelta[s]);+         strncat (Str, chaine, (size_t) 10);+      }++      statcoll_SetDesc (res->Collector[s], Str);+   }+}+++/*=======================================================================*/++static void WriteDataPowDiv (+   unif01_Gen *gen,+   smultin_Param *par,+   smultin_Res *res, +   char *TestName,+   long N,                    /* Number of replications */+   long n,                    /* Number of balls */+   int r,                     /* Drop r bits from each random number */+   long d,                    /* Number of segments on 1-dimensional line */+   int t,                     /* Dimension */+   lebool Sparse,+   smultin_CellType k         /* Number of urns */+)+/*+ * Write the parameters of the test+ */+{+   double EC;+   double NbExp;+   DeltaIndex s;++   swrite_Head (gen, TestName, N, n, r);++   if (par->GenerCell == smultin_GenerCellSerial) {+      printf (",   d = %4ld,   t = %2d,\n       Sparse = ", d, t);+      util_WriteBool (Sparse, 6);+      printf ("\n\n");+      printf ("       GenerCell = smultin_GenerCellSerial\n");+      printf ("       Number of cells = d^t = ");+   } else if (par->GenerCell == smultin_GenerCellSerial2) {+      printf (",   d = %4ld,   t = %2d,\n       Sparse = ", d, t);+      util_WriteBool (Sparse, 6);+      printf ("\n\n");+      printf ("       GenerCell = smultin_GenerCellSerial2\n");+      printf ("       Number of cells = d^t = ");+   } else if (par->GenerCell == smultin_GenerCellPermut) {+      printf (",   t = %2d,\n       Sparse = ", t);+      util_WriteBool (Sparse, 6);+      printf ("\n\n");+      printf ("       GenerCell = smultin_GenerCellPermut\n");+      util_Assert (!res->Over,+         "MultinomialOver: non implemented for smultin_GenerCasePermut");+      printf ("       Number of cells = t! = ");+   } else if (par->GenerCell == smultin_GenerCellMax) {+      printf (",   k = %2d,\n       Sparse = ", t);+      util_WriteBool (Sparse, 6);+      printf ("\n\n");+      printf ("       GenerCell = smultin_GenerCellMax\n");+      printf ("       Number of cells = k = ");+   }++#ifdef USE_LONGLONG+   printf ("%18" PRIuLEAST64 "\n", k);+#else+   printf ("%18.0f\n", k);+#endif++   util_Assert (k <= smultin_env.Maxk, "Multinomial:  k is too large");+   printf ("       Expected number per cell =  ");+   NbExp = (double) n / k;+   if (NbExp < 1.0)+      printf ("1 / %10.8g\n", 1.0 / NbExp);+   else+      printf ("%10.8g\n", NbExp);++   EC = (double) n * n / (2.0 * k);+   if (Sparse)+      printf ("       EColl = n^2 / (2k) = %12.10g\n", EC);+   printf ("       Hashing = ");+   util_WriteBool (res->Hashing, 6);+   printf ("\n\n");+   if (par->NbDelta == 1 && par->ValDelta[0] == -1)+      ;+   else {+      if (Sparse) {+         printf ("   For Delta > -1, we use the normal approximation\n");+         printf ("   Mean and standard deviation: \n");+      } else {+         printf ("   For Delta > -1, we use the ChiSquare approximation\n");+         printf ("   Correction factor of the ChiSquare: \n");+      }+   }++   for (s = 0; s < par->NbDelta; s++) {+      if (fabs (par->ValDelta[s] + 1.0) < EPS_LAM) {+         if ((Sparse == FALSE) && (res->Over == FALSE)) {+            /* The collision test is meaningless when Sparse = FALSE */+            continue;+         }+         printf ("       Collision test");+      } else {+         printf ("       Delta = %5.2g", par->ValDelta[s]);+      }+      if (!res->Over || fabs (par->ValDelta[s] + 1.0) > EPS_LAM) {+         printf (",    Mu = %14.8g", res->Mu[s]);+         printf (",    Sigma = %10.6g", res->Sigma[s]);+         util_Assert (res->Sigma[s] > 0.0, "Negative Variance");+      }+      printf ("\n");+   }+   printf ("\n");+}+++/*=======================================================================*/++static void WriteDataMNBits (+   unif01_Gen *gen,+   smultin_Param *par,+   smultin_Res *res, +   char *TestName,+   long N,                    /* Number of replications */+   long n,                    /* Number of balls */+   int r,                     /* Drop r bits from each random number */+   long L,                    /* Number of bits for a cell */+   int s,                     /* Number of bits taken from each rand. num. */+   lebool Sparse,+   smultin_CellType k,        /* Number of cells = 2^L */+   lebool Over               /* Overlapping case = TRUE */+)+/*+ * Write the parameters of the test+ */+{++   double EC;+   double NbExp;+   DeltaIndex j;++   swrite_Head (gen, TestName, N, n, r);++   printf (",   s = %2d,   L = %4ld,\n       Sparse = ", s, L);+   util_WriteBool (Sparse, 6);+   if (Over)+      printf ("\n\n       Number of bits = n = %1ld\n", n);+   else+      printf ("\n\n       Number of bits = n*L = %1ld\n", L * n);++   /* printf (" GenerCell = smultin_GenerCellSerialBits\n"); */++#ifdef USE_LONGLONG+   printf ("       Number of cells = 2^L = %18" PRIuLEAST64 "\n", k);+#else+   printf ("       Number of cells = 2^L = %18.0f\n", k);+#endif+   util_Assert (k <= smultin_env.Maxk, "Multinom:  k is too large");++   printf ("       Expected number per cell =  ");+   NbExp = (double) n / k;+   if (NbExp < 1.0)+      printf ("1 / %10.8g\n", 1.0 / NbExp);+   else+      printf ("%10.8g\n", NbExp);++   EC = (double) n * n / (2.0 * k);+   if (Sparse)+      printf ("       EColl = n^2 / (2k) = %12.10g\n", EC);+   printf ("       Hashing = ");+   util_WriteBool (res->Hashing, 6);+   printf ("\n\n");+   if (par->NbDelta == 1 && par->ValDelta[0] == -1)+      ;+   else {+      if (Sparse) {+         printf ("   For Delta > -1, we use the normal approximation\n");+         printf ("   Mean and standard deviation: \n");+      } else {+         printf ("   For Delta > -1, we use the ChiSquare approximation\n");+         printf ("   Correction factor of the ChiSquare: \n");+      }+   }++   for (j = 0; j < par->NbDelta; j++) {+      if (fabs (par->ValDelta[j] + 1.0) < EPS_LAM) {+         if ((Sparse == FALSE) && (res->Over == FALSE)) {+            /* The collision test is meaningless when Sparse = FALSE */+            continue;+         }+         printf ("       Collision test");+      } else {+         printf ("       Delta = %5.2g", par->ValDelta[j]);+      }+      if (!res->Over || fabs (par->ValDelta[j] + 1.0) > EPS_LAM) {+         printf (",    Mu = %14.8g", res->Mu[j]);+         printf (",    Sigma = %10.6g\n", res->Sigma[j]);+         util_Assert (res->Sigma[j] > 0.0, "Negative Variance");+      }+   }+   printf ("\n");+}+++/*=======================================================================*/++static void CalcResultsPowDiv (+   smultin_Param *par,+   smultin_Res *res, +   DeltaIndex s,                  /* Which statistic */+   long n,                        /* Number of balls */+   lebool Sparse,+   smultin_CellType DegreLib,     /* Number of degrees of freedom */+   double Mu,                     /* Mean */+   double SumX[],+   double SumX2[]+   )+{++   double pR, pL;+   double pCollLeft;              /* Left p-value of Collision test */+   double pCollRight;             /* Right p-value of Collision test */+   int j;+   statcoll_Collector *SC = res->Collector[s];+   fmass_INFO Mass1, Mass2;+   double V[1];+   long N = SC->NObs;+   double racN;++   if (fabs (par->ValDelta[s] + 1.0) < EPS_LAM) {+      /* Collision Test */+      if (!Sparse) {+         res->pColl = -1.0;+         res->pCollLeft = -1.0;+         res->pCollRight = -1.0;+         return;+      }+      /* The total number of collisions of N replications is NbCollisions */+      Mass1 = smultin_CreateCollisions (n, DegreLib + 1);+      if (N == 1) {+         pCollLeft = smultin_FDistCollisions (Mass1, (long) res->NbCollisions);+         pCollRight = smultin_FBarCollisions (Mass1, (long) res->NbCollisions);+         res->pCollLeft = pCollLeft;+         res->pCollRight = pCollRight;+         res->sVal2[s][gofw_Mean] = SumX[s];+         res->pVal2[s][gofw_Mean] = fbar_Normal1 (res->sVal2[s][gofw_Mean]);+      } else {+         if (Mu < smultin_env.SeuilEColl) {+            Mass2 = fmass_CreatePoisson (N * Mu);+            pCollLeft = fdist_Poisson2 (Mass2, (long) res->NbCollisions);+            pCollRight = fbar_Poisson2 (Mass2, (long) res->NbCollisions);+            fmass_DeletePoisson (Mass2);+         }+      }+      smultin_DeleteCollisions (Mass1);+      res->pColl = gofw_pDisc (pCollLeft, pCollRight);++      /* Total number of empty urns of the N replications: res->NbCells[0]+      Mass2 = fmass_CreatePoisson (res->EsEmpty);+      pL = fdist_Poisson2 (Mass2, res->NbCells[0]);+      pR = fbar_Poisson2 (Mass2, res->NbCells[0]);+      fmass_DeletePoisson (Mass2);+      res->pEmpty = gofw_pDisc (pL, pR); */++      /* Since we can have very large values of res->EsEmpty (2^63), we+         compute the Poisson pL, pR by calling the Gamma distribution, since+         our Poisson takes a long argument */++      if (res->NbCells[0] <= EMPTYLIM && res->EsEmpty <= EMPTYLIM) {+	 pL = fbar_Gamma (res->NbCells[0] + 1.0, 12, res->EsEmpty);+	 if ((res->NbCells[0] <= 0)  || (res->NbCells[0] > res->NbCellsTotal))+	    pR = 1.0;+	 else+	    pR = fdist_Gamma ((double) (res->NbCells[0]), 12, res->EsEmpty);+	 res->pEmpty = gofw_pDisc (pL, pR);+      }+      /* The total number of urns containing >= j balls */+      for (j = 2; j <= par->bmax; j++) {+         Mass2 = fmass_CreatePoisson ((double) (res->EsCells[j]));+         pL = fdist_Poisson2 (Mass2, (long) res->WbCells[j]);+         pR = fbar_Poisson2 (Mass2, (long) res->WbCells[j]);+         fmass_DeletePoisson (Mass2);+         res->pWb[j] = gofw_pDisc (pL, pR);+      }++   } else if (Sparse) {+      /* Tests other than Collision test */+      gofw_ActiveTests1 (SC->V, N, wdist_Normal, (double *) NULL,+                         res->sVal2[s], res->pVal2[s]);++   } else {+      V[0] = DegreLib;+      gofw_ActiveTests1 (SC->V, N, wdist_ChiSquare, V,+                         res->sVal2[s], res->pVal2[s]);+   }++   /* Now compute the mean and the correlation with their p-values. */+   if (N > 1) {+      racN = sqrt ((double) N);+      res->sVal2[s][gofw_Mean] = SumX[s] / racN;+      res->pVal2[s][gofw_Mean] = fbar_Normal1 (res->sVal2[s][gofw_Mean]);+      res->sVal2[s][gofw_Cor] = racN * SumX2[s] / (N - 1);+      res->pVal2[s][gofw_Cor] = fbar_Normal1 (res->sVal2[s][gofw_Cor]);+   }+}+++/*=======================================================================*/++static void WriteResultsPowDiv (+   smultin_Param *par,+   smultin_Res *res, +   DeltaIndex s,+   long N,+   double EColl,              /* Approximate expected number of collisions */+   smultin_CellType DegreLib, /* Number of degrees of freedom */+   lebool Sparse,+   double Mu                  /* Exact expected mean */+   )+{+   long j;+   printf ("-----------------------------------------------\n");+   printf ("Test Results for ");++   if (fabs (par->ValDelta[s] + 1.0) < EPS_LAM)+      printf ("Collisions\n\n");+   else {+      printf ("Delta = %8.4f\n\n", par->ValDelta[s]);+      if (N == 1) {+         if (!Sparse) {+#ifdef USE_LONGLONG+            printf ("Number of degrees of freedom          : %4" PRIuLEAST64+               "\n", DegreLib);+#else+            printf ("Number of degrees of freedom          : %4.0f\n",+               DegreLib);+#endif++         }+         printf ("Value of the statistic                :");+         gofw_Writep2 (res->sVal2[s][gofw_Mean], res->pVal2[s][gofw_Mean]);++      } else {+         gofw_WriteActiveTests0 (N, res->sVal2[s], res->pVal2[s]);+         printf ("For the sum of the N observations, we use\n");+         printf ("      the Normal approximation:\n");+         printf ("Standardized empirical mean           :");+         gofw_Writep2 (res->sVal2[s][gofw_Mean], res->pVal2[s][gofw_Mean]);+         printf ("Standardized empirical correlation    :");+         gofw_Writep2 (res->sVal2[s][gofw_Cor], res->pVal2[s][gofw_Cor]);+      }+   }++   if (swrite_Collectors) {+      if (fabs (par->ValDelta[s] + 1.0) < EPS_LAM)+         statcoll_Write (res->Collector[s], 5, 14, 0, 0);+      else+         statcoll_Write (res->Collector[s], 5, 14, 4, 3);+   }++   if (fabs (par->ValDelta[s] + 1.0) < EPS_LAM) {+      if (N > 1 && Mu < smultin_env.SeuilEColl) {+         printf ("For the total number of collisions, we use\n"+            "      the Poisson approximation:\n");+         /* "Value of N * EColl : "); num_WriteD(N * EColl, 11, 2, 2); */+         printf ("Expected number of collisions = N*Mu  : ");+         num_WriteD (N * Mu, 11, 2, 2);+         printf ("\nObserved number of collisions         : %8ld\n",+            (long) res->NbCollisions);+         gofw_Writep1 (res->pColl);+         printf ("\n");+      }+      if (N == 1) {+	/*     printf ("Value of EColl                        : ");+	       num_WriteD(EColl, 11, 2, 2);*/+         printf ("Expected number of collisions = Mu    : ");+         num_WriteD (Mu, 11, 2, 2);+         printf ("\nObserved number of collisions         : %8ld\n",+            (long) res->NbCollisions);+         gofw_Writep1 (res->pColl);+      }+      printf ("-----------------------------\n");+      printf ("Total number of cells containing j balls\n\n");+      for (j = 0; j <= smultin_MAXB / 2; j++) {+         printf ("  j = %2ld", j);++#ifdef USE_LONGLONG+         printf ("                              : %16" PRIuLEAST64 "\n",+            res->NbCells[j]);+#else+         printf ("                              : %16.0f\n", res->NbCells[j]);+#endif+      }++      if (par->bmax >= 0 && res->NbCells[0] <= EMPTYLIM &&+            res->EsEmpty <= EMPTYLIM) {+         printf ("\n-----------------------------\n"+            "Results for the number of empty cells\n\n"+            "Expected number                       : ");+         num_WriteD (res->EsEmpty, 19, 2, 2);+         printf ("\nObserved number                       :");+#ifdef USE_LONGLONG+         printf (" %16" PRIuLEAST64 "\n", res->NbCells[0]);+#else+         printf (" %16.0f\n", res->NbCells[0]);+#endif+         gofw_Writep1 (res->pEmpty);+      }+      if (par->bmax >= 1) {+         printf ("\n-----------------------------\n");+         printf ("Results for the number of cells containing at least"+            " j balls\n\n");+         for (j = 2; j <= par->bmax; j++) {+            printf ("  j = %2ld\n", j);+            printf ("Expected number                       : %11.2f\n",+               (double) (res->EsCells[j]));+            printf ("Observed number                       : %8.0f\n",+               (double) (res->WbCells[j]));+            gofw_Writep1 (res->pWb[j]);+         }+      }+   }+   printf ("\n");+}+++/*=======================================================================*/++static void UpdateCountHash (+   smultin_Res *res, +   smultin_CellType Ind,+   long Hache,+   double UnSurHache,+   long *CoMax,+   lebool DimFlag          /* TRUE for t-1 dimension, FALSE for t dim. */+   )+/*+ * We use hashing. A ball falls in cell Ind: update counters+ * Speed is essential here.+ */+{+   long *Count;+   smultin_CellType *Cell;+   smultin_CellType *Nb;+   long Decal, Pos, Tem;++   if (DimFlag == FALSE) {+      Count = res->Count;         /* Counters in t dimensions */+      Cell = res->Cell;           /* Cell numbers in t dimensions */+      Nb = res->Nb;+   } else {+      Count = res->Count1;        /* Counters in t - 1 dimensions */+      Cell = res->Cell1;          /* Cell numbers in t - 1 dimensions */+      Nb = res->Nb1;+   }++#ifdef USE_LONGLONG+   Pos = Ind % Hache;+#else+   Tem = Ind * UnSurHache;+   Pos = Ind - (double) Hache * Tem;+#endif++   Decal = HACHE2 + Pos % HACHE2;++   /* Insert in hashing table; if sign bit is 1, cell is empty. */+   for (;;) {+#ifdef USE_LONGLONG+      if (Cell[Pos] & MASK64) {+#else+      if (Cell[Pos] < 0.0) {+#endif+         Cell[Pos] = Ind;+         break;+      }+      if (Cell[Pos] == Ind)+         break;+      Pos = (Pos + Decal) % Hache;+   }++   Nb[Count[Pos]] -= 1;+   ++(Count[Pos]);+   if (Count[Pos] > *CoMax)+      ++(*CoMax);+   if (DimFlag == FALSE) {+      if (*CoMax > res->NbSize) {+         int i;+         res->NbSize *= 2;+         res->Nb = util_Realloc (res->Nb,+            (res->NbSize + 1) * sizeof (smultin_CellType));+         Nb = res->Nb;+         for (i = res->NbSize / 2 + 1; i <= res->NbSize; i++)+            Nb[i] = 0;+      }+   } else {+      if (*CoMax > res->Nb1Size) {+         int i;+         res->Nb1Size *= 2;+         res->Nb1 = util_Realloc (res->Nb1,+            (res->Nb1Size + 1) * sizeof (smultin_CellType));+         Nb = res->Nb1;+         for (i = res->Nb1Size / 2 + 1; i <= res->Nb1Size; i++)+            Nb[i] = 0;+      }+   }+   Nb[Count[Pos]] += 1;+}+++/*=======================================================================*/++static void GenerAllPointsHash (unif01_Gen * gen, smultin_Param * par,+   smultin_Res * res, long n, int r, long d, int t, long *pCoMax,+   long Hache, double UnSurHache)+/*+ * Generate all n points in hashing case+ */+{+   smultin_CellType Indice;       /* Cell number */+   long i;++   for (i = 0; i <= Hache; i++)+#ifdef USE_LONGLONG+      res->Cell[i] = MASK64;      /* Empty cells */+#else+      res->Cell[i] = -1.0;        /* Empty cells */+#endif+   *pCoMax = 0;+   for (i = 1; i <= n; i++) {+      Indice = par->GenerCell (gen, r, t, d);+      UpdateCountHash (res, Indice, Hache, UnSurHache, pCoMax, FALSE);+   }+}+++/*=======================================================================*/++static void GenerAllPoints2 (unif01_Gen * gen, smultin_Param * par,+   smultin_Res * res, long n, int r, long d, int t)+/*+ * Generate all n points; no hashing+ */+{+   smultin_CellType Indice;       /* Cell number */+   long i;+   for (i = 1; i <= n; i++) {+      Indice = par->GenerCell (gen, r, t, d);+      ++res->Count[(long) Indice];+   }+}+++/*=======================================================================*/++static void GenerAllPointsHashBits (unif01_Gen *gen, smultin_Res *res,+   long n, int r, long L, int s, long *pCoMax, long Hache,+   double UnSurHache)+/*+ * Generate all n points of L bits each in hashing case+ */+{+   smultin_CellType Indice;       /* Cell number */+   long i;+   int j;+   unsigned long Z;+   const int t = s / L;           /* Number of points in a U01 */+   const long Last = n % t;+   const unsigned long MASK = num_TwoExp[L] - 1.0;++   for (i = 0; i <= Hache; i++)+#ifdef USE_LONGLONG+      res->Cell[i] = MASK64;      /* Empty cells */+#else+      res->Cell[i] = -1.0;        /* Empty cells */+#endif+   *pCoMax = 0;++   for (i = 1; i <= n / t; i++) {+      Z = unif01_StripB (gen, r, s);+      for (j = 1; j <= t; j++) {+         Indice = Z & MASK;+         UpdateCountHash (res, Indice, Hache, UnSurHache, pCoMax, FALSE);+         Z >>= L;+      }+   }+   /* The last points */+   if (Last > 0) {+      Z = unif01_StripB (gen, r, s);+      /* The most significant bits make the points */+      for (j = 1; j <= t - Last; j++)+         Z >>= L;+      for (j = 1; j <= Last; j++) {+         Indice = Z & MASK;+         UpdateCountHash (res, Indice, Hache, UnSurHache, pCoMax, FALSE);+         Z >>= L;+      }+   }+}+++/*=======================================================================*/++static void GenerAllPoints2Bits (unif01_Gen * gen, smultin_Res * res,+   long n, int r, long L, int s)+/*+ * Generate all n points of L bits each; no hashing+ */+{+   long i;+   int j;+   unsigned long Z;+   const int t = s / L;+   const long Last = n % t;+   const unsigned long MASK = num_TwoExp[L] - 1.0;++   for (i = 1; i <= n / t; i++) {+      Z = unif01_StripB (gen, r, s);+      for (j = 1; j <= t; j++) {+         ++res->Count[Z & MASK];+         Z >>= L;+      }+   }+   /* The last points */+   if (Last > 0) {+      Z = unif01_StripB (gen, r, s);+      /* The most significant bits make the points */+      for (j = 1; j <= t - Last; j++)+         Z >>= L;+      for (j = 1; j <= Last; j++) {+         ++res->Count[Z & MASK];+         Z >>= L;+      }+   }+}+++/*=======================================================================*/++static void Multinom (unif01_Gen * gen, smultin_Param * par,+   smultin_Res * res, long N, long n, int r, long d, int t, lebool Sparse,+   smultin_CellType k, char *TestName, chrono_Chrono * Timer, lebool BitFlag)+/* + * If BitFlag = TRUE, this procedure was called from smultin_MultinomialBits,+ * otherwise from smultin_Multinomial. + * In the case BitFlag = TRUE, t stand for s, d for L. Otherwise, all+ * parameters are as in smultin_Multinomial.+ *+ * Sparse:   normal approximation for Delta != -1.+ * Non sparse:  chi-square approximation.+ * Collisions test meaningfull only in Sparse case.+ */+{+   long Seq;                      /* Replication number */+   double NbExp;                  /* Expected number per cell */+   double EColl;                  /* Approx. expected number of collisions */+   long Hache;                    /* Hashing module */+   double UnSurHache;+   double HacheLR;                /* Dimension of hashing table */+   long i;+   long CoMax;                    /* Maximum number of balls in any cell */+   double X0, X;                  /* Statistics */+   DeltaIndex j;                  /* Which power divergence case */+   double SumX2[smultin_MAX_DELTA];+   double SumX[smultin_MAX_DELTA];+   double X0Pre[smultin_MAX_DELTA]; /* For empirical mean and correlation */+   lebool localRes = FALSE;++   NbExp = (double) n / k;+   EColl = (double) n / (2.0 * k) * n;++   if (par == NULL)+      par = &smultin_ParamDefault;+   if (res == NULL) {+      localRes = TRUE;+      res = smultin_CreateRes (par);+   } else+      /* Clean memory from a previous call */+      CleanPD (res);++   InitRes (par, res, N);+   res->NbCellsTotal = k;+   res->Over = FALSE;+   InitPowDiv (par, res, N, Sparse, n, k);++   if (swrite_Basic) {+      if (BitFlag)+         /* Here t stand for s, d for L */+         WriteDataMNBits (gen, par, res, TestName, N, n, r, d, t, Sparse, k,+                          FALSE);+      else+         WriteDataPowDiv (gen, par, res, TestName, N, n, r, d, t, Sparse, k);+   }+   /* Initialize the hashing constants and tables */+   CalcTabFj (par, res, Sparse, (double) k, NbExp);+   for (j = 0; j < par->NbDelta; j++) {+      SumX[j] = 0.0;+      SumX2[j] = 0.0;+      X0Pre[j] = 0.0;+   }+   if (res->Hashing)+      Hache = tables_HashPrime (n, smultin_env.HashLoad);+   else+      Hache = k;+   HacheLR = Hache;+   UnSurHache = 1.0 / HacheLR;+   res->CountSize = Hache;+   res->Count = util_Calloc ((size_t) Hache + 2, sizeof (long));+   res->Cell = util_Calloc ((size_t) Hache + 2, sizeof (smultin_CellType));+   res->NbSize = 8000;+   res->Nb = util_Calloc ((size_t) res->NbSize + 2, sizeof (smultin_CellType));++   /* Generate the points or balls */+   for (Seq = 1; Seq <= N; Seq++) {+      for (i = 0; i <= Hache; i++)+         res->Count[i] = 0;+      res->Nb[0] = k;+      for (i = 1; i <= res->NbSize; i++)+         res->Nb[i] = 0;++      if (BitFlag) {+         /* Here, d stands for L, and t for s */+         if (res->Hashing)+            GenerAllPointsHashBits (gen, res, n, r, d, t, &CoMax, Hache,+               UnSurHache);+         else+            GenerAllPoints2Bits (gen, res, n, r, d, t);+      } else {+         if (res->Hashing)+            GenerAllPointsHash (gen, par, res, n, r, d, t, &CoMax, Hache,+               UnSurHache);+         else+            GenerAllPoints2 (gen, par, res, n, r, d, t);+      }++      if (swrite_Counters) {+         if (res->Hashing)+#ifdef USE_LONGLONG+            tables_WriteTabULL (res->Nb, 0, CoMax, 5, 12,+               "Observed numbers in res->Nb");+#else+            tables_WriteTabD (res->Nb, 0, CoMax, 5, 12, 0, 0,+               "Observed numbers in res->Nb");+#endif+         else if (!Sparse)+            tables_WriteTabL (res->Count, 0, res->CountSize - 1, 5, 10,+                              "Observed numbers in res->Count");+      }++      /* The points have been generated; now compute the statistics */+      /* if (par->bmax >= 0) */+      CalcNbCells (par, res, 0, Hache - 1, CoMax);++      for (j = 0; j < par->NbDelta; j++) {+         if (res->Hashing) {+            CalcPoDiEqHache (par, res, j, NbExp, res->Nb, CoMax, TRUE, &X);+         } else if (res->flagTab) {+            CalcPowDivEqual (par, res, j, NbExp, res->Count,+                             0, (long) k - 1, TRUE, &X);+         } else {+            CalcPowDivEqual (par, res, j, NbExp, res->Count,+                             0, (long) k - 1, FALSE, &X);+         }+         X0 = (X - res->Mu[j]) / res->Sigma[j];+         if (fabs (par->ValDelta[j] + 1.0) < EPS_LAM) {+            res->Nb[0] = k + X - n;+            res->NbCollisions += X;+            statcoll_AddObs (res->Collector[j], X);+         } else {+            statcoll_AddObs (res->Collector[j], X0);+            if (!Sparse)+               X0 = (X0 - k + 1.0) / sqrt (2.0 * k - 2.0);+         }+         /* Now, X0 is standardized, with mean 0 and variance 1.  */+         /* The following is to compute the mean and correlation. */+         SumX[j] += X0;+         SumX2[j] += X0 * X0Pre[j];+         X0Pre[j] = X0;+      }+   }++   for (j = 0; j < par->NbDelta; j++) {+      if ((Sparse == FALSE) && (fabs (par->ValDelta[j] + 1.0) < EPS_LAM))+         continue;+      CalcResultsPowDiv (par, res, j, n, Sparse, k - 1, res->Mu[j],+                         SumX, SumX2);+   }++   if (swrite_Basic) {+      for (j = 0; j < par->NbDelta; j++) {+         if ((Sparse == FALSE) && (fabs (par->ValDelta[j] + 1.0) < EPS_LAM)) {+            util_Warning (TRUE,+               "The collision test is meaningless when Sparse = FALSE");+            continue;+         }+         WriteResultsPowDiv (par, res, j, N, EColl, k - 1, Sparse, res->Mu[j]);+      }+      swrite_Final (gen, Timer);+   }+   if (localRes)+      smultin_DeleteRes (res);+}+++/*=======================================================================*/++void smultin_Multinomial (unif01_Gen * gen, smultin_Param * par,+   smultin_Res * res, long N, long n, int r, long d, int t, lebool Sparse)+/* + * Sparse:   normal approximation for Delta != -1.+ * Non sparse:  chi-square approximation.+ * Collisions test meaningfull only in Sparse case.+ */+{+   smultin_CellType k;            /* Number of cells */+   int i;+   chrono_Chrono *Timer;+   char *TestName = "smultin_Multinomial test";++   Timer = chrono_Create ();+   if (NULL == par)+      par = &smultin_ParamDefault;++   if (par->GenerCell == smultin_GenerCellSerial ||+      par->GenerCell == smultin_GenerCellSerial2) {+      util_Assert (d > 1, "smultin_Multinomial:   d <= 1");+      util_Assert (t > 0, "smultin_Multinomial:   t < 1");+      k = d;+      for (i = 2; i <= t; i++)+         k *= d;++   } else if (par->GenerCell == smultin_GenerCellPermut) {+      util_Assert (t > 1, "Permutation... smultin_Multinomial:   t < 2");+#ifdef USE_LONGLONG+      /* longlong has more bits of precision than double */+      util_Assert (t <= 20, "smultin_GenerCellPermut:  t > 20");+      if (t == 20) {+         k = num2_Factorial (18) * 19 * 20;+      } else if (t == 19) {+         k = num2_Factorial (18) * 19;+      } else+         k = num2_Factorial (t);+#else+      util_Assert (t <= 18, "smultin_GenerCellPermut:  t > 18");+      k = num2_Factorial (t);+#endif++   } else if (par->GenerCell == smultin_GenerCellMax) {+      util_Assert (t > 1, "GenerCellMax... smultin_Multinomial:   t < 2");+      k = t;++   } else+      util_Error ("smultin_Multinomial:   par->GenerCell not initialized");++   util_Assert (k <= smultin_env.Maxk,+      "smultin_Multinomial:   k > smultin_env.Maxk");+   util_Assert (n > 4, "smultin_Multinomial:   n <= 4");+#ifndef USE_LONGLONG+   util_Assert ((double) n / k > 1.0 / num_TwoExp[31],+      "smultin_Multinomial:   NbExp <= 1/2^31");+#endif+   Multinom (gen, par, res, N, n, r, d, t, Sparse, k, TestName, Timer, FALSE);+   chrono_Delete (Timer);+}+++/*=======================================================================*/++static void InitCollOver (+   smultin_Res *res, +   long n,                    /* Number of balls */+   smultin_CellType k,        /* Number of cells = d^t */+   long d,                    /* One-dim. segment */+   int t,                     /* dimension */+   double *Esperance,         /* Expectation value */+   double *StandDev           /* Standard deviation */+   )+/*+ * Initialize the collisionOver test+ */+{+   const double Epsilon = 1.0E-20;+   const int MaxIter = 32;+   long j;+   double terme;+   double v;+   double COverDelta;++   res->NbCollisions = 0.0;+   res->NbCells[0] = 0;+   res->CollApprox = smultin_CollNotInit;+   *Esperance = -1.0;+   *StandDev = -1.0;+   COverDelta = (double) (n - t + 1)/ k;++   if (COverDelta > smultin_env.SeuilCOverNorSup &&+      COverDelta < smultin_env.SeuilCOverDense) {+      res->CollApprox = smultin_CollPoissonDense;+      *Esperance = k * exp (-COverDelta);++   } else if (COverDelta >= smultin_env.SeuilCOverNorInf &&+      COverDelta <= smultin_env.SeuilCOverNorSup) {+      res->CollApprox = smultin_CollNormal;+      *Esperance = k * (COverDelta - 1.0 + exp (-COverDelta));+      terme = k * exp (-COverDelta) * (1.0 - (1.0 + COverDelta) *+                        exp (-COverDelta));+      /* The general formula given by Marsaglia is not very good; the above+         formula used Rukhin's correction. The following values were obtained+         by Marsaglia by simulation for the special cases: */+      if (n == 2097152 && k == 1048576) {+         if ((d == 32) && (t == 4)) {+            terme = 295.0 * 295.0; /* OQSO test */+         }+         if ((d == 4) && (t == 10)) {+            terme = 339.0 * 339.0; /* DNA test */+         }+      }+      if (terme < 0.0) {+         util_Warning (TRUE, "***** InitCollOver ******* VARIANCE < 0 !!");+         *Esperance = -1.0;+         *StandDev = -1.0;+      } else+         *StandDev = sqrt (terme);++   } else if (COverDelta < smultin_env.SeuilCOverSparse) {+      res->CollApprox = smultin_CollPoissonSparse;+      if (COverDelta < 0.1) {+         /* Avoid loss of precision when COverDelta --> 0 */+         j = 3;+         v = 2.0;+         terme = COverDelta * COverDelta / 2.0;+         *Esperance = terme;+         while (fabs (terme / *Esperance) > Epsilon && j < MaxIter) {+            v += 1.0;+            terme = -terme * COverDelta / v;+            *Esperance += terme;+            ++j;+         }+         *Esperance *= k;+      } else+         *Esperance = k * (COverDelta - 1.0 + exp (-COverDelta));+   }+}+++/*=======================================================================*/++static void WriteDataCollOver (+   smultin_Res *res, +   long n,                    /* Number of balls */+   smultin_CellType k,        /* Number of cells */+   double Esperance,          /* Expectation value */+   double StandDev            /* Standard deviation */+   )+{+   double COverDelta = (double) (n) / k;+   printf ("       CollisionOver:   density = n / k = ");+   if (COverDelta >= 1.0)+      num_WriteD (COverDelta, 10, 2, 2);+   else {+      printf (" 1 / ");+      num_WriteD (1.0 / COverDelta, 10, 2, 1);+   }+   printf ("\n");+   if (res->CollApprox == smultin_CollPoissonDense) {+      printf ("       Expected number of empty cells = Mu = ");+      num_WriteD (Esperance, 10, 2, 2);+      printf ("\n");+   } else if (res->CollApprox == smultin_CollNormal) {+      printf ("       Expected number of collisions = ");+      num_WriteD (Esperance, 10, 2, 2);+      printf ("\n");+      printf ("       Expected standard deviation = ");+      num_WriteD (StandDev, 10, 2, 2);+   } else if (res->CollApprox == smultin_CollPoissonSparse) {+      printf ("       Expected number of collisions = Mu = ");+      num_WriteD (Esperance, 10, 2, 2);+   } else {+      printf ("       NO TEST FOR THIS DENSITY  n/k");+   }+   printf ("\n\n");+}+++/*=======================================================================*/++static void CalcResCollOver (+   smultin_Res *res, +   DeltaIndex s,+   long N,                    /* Number of replications */+   double Esperance,          /* Expectation value */+   double SumX,+   double SumX2+   )+/*+ * Compute results for CollisionOver test+ */+{+   double pCollLeft;              /* Left p-value of Collision test */+   double pCollRight;             /* Right p-value of Collision test */+   double racN;+   fmass_INFO W;+   statcoll_Collector *Q = res->Collector[s];++   res->Mu[s] = Esperance;+   if (Esperance < 0.0) {+      res->pVal2[s][gofw_KSP] = -1.0;+      res->pVal2[s][gofw_Mean] = -1.0;+      res->pColl = -1.0;+      return;+   }++   switch (res->CollApprox) {++   case smultin_CollNormal:+      gofw_ActiveTests1 (Q->V, Q->NObs, wdist_Normal, (double *) NULL,+         res->sVal2[s], res->pVal2[s]);+      /* This line is necessary for the array pd from module tmultin */+      res->pColl = res->pVal2[s][gofw_Mean];+      if (N > 1) {+         racN = sqrt ((double) N);+         /* Calculate the mean, the correlation and their p-values */+         res->sVal2[s][gofw_Mean] = SumX / racN;+         res->pVal2[s][gofw_Mean] = fbar_Normal1 (res->sVal2[s][gofw_Mean]);+         res->sVal2[s][gofw_Cor] = racN * SumX2 / (N - 1);+         res->pVal2[s][gofw_Cor] = fbar_Normal1 (res->sVal2[s][gofw_Cor]);+         /* This line is necessary for the array pd from module tmultin */+         res->pColl = res->pVal2[s][gofw_KSP];+      }+      break;++   case smultin_CollPoissonSparse:+      /* The sum of N Poisson obeys also a Poisson law */+      W = fmass_CreatePoisson (N * Esperance);+      pCollLeft = fdist_Poisson2 (W, (long) res->NbCollisions);+      pCollRight = fbar_Poisson2 (W, (long) res->NbCollisions);+      res->pColl = gofw_pDisc (pCollLeft, pCollRight);+      fmass_DeletePoisson (W);+      break;++   case smultin_CollPoissonDense:+      /* The sum of N Poisson obeys also a Poisson law */+#if 0+      W = fmass_CreatePoisson (N * Esperance);+      pCollLeft = fdist_Poisson2 (W, res->NbCells[0]);+      pCollRight = fbar_Poisson2 (W, res->NbCells[0]);+      res->pColl = res->pEmpty = gofw_pDisc (pCollLeft, pCollRight);+      fmass_DeletePoisson (W);+#endif+      /* Since we can have very large values of res->NbCells[0]) (2^52), we+         compute the Poisson pCollLeft, pCollRight by calling the Gamma+         distribution, since our Poisson takes a long (31 bits) argument. */++      if (res->NbCells[0] <= EMPTYLIM && N * Esperance <= EMPTYLIM) {+         pCollLeft = fbar_Gamma (res->NbCells[0] + 1.0, 15, N * Esperance);+         if ((res->NbCells[0] <= 0) || (res->NbCells[0] > res->NbCellsTotal))+            pCollRight = 1.0;+         else+            pCollRight = fdist_Gamma ((double) (res->NbCells[0]), 15,+               N * Esperance);+         res->pEmpty = res->pColl = gofw_pDisc (pCollLeft, pCollRight);+      }+      break;++   default:+      util_Error ("res->CollApprox:   Impossible case");+   }+}+++/*=======================================================================*/++static void WriteResCollOver (+   smultin_Param *par,+   smultin_Res *res, +   DeltaIndex s,+   long N,                    /* Number of replications */+   double EColl,+   double Esperance+   )+/*+ * Write results for CollisionOver test+ */+{+   int j;+   printf ("\n-----------------------------------------------\n"+           "Results of CollisionOver test:\n\n");+   if (Esperance < 0.0) {+      util_Warning (TRUE, "TEST NON IMPLEMENTED FOR THESE PARAMETERS");+      return;+   }++   switch (res->CollApprox) {++   case smultin_CollNormal:+      printf ("NORMAL approximation:\n");+      if (N == 1) {+         printf ("Value of the standardized statistic   :");+         gofw_Writep2 (res->sVal2[s][gofw_Mean], res->pVal2[s][gofw_Mean]);+      } else {+         gofw_WriteActiveTests0 (N, res->sVal2[s], res->pVal2[s]);+         printf ("Standardized empirical mean           :");+         gofw_Writep2 (res->sVal2[s][gofw_Mean], res->pVal2[s][gofw_Mean]);+         printf ("Standardized empirical correlation    :");+         gofw_Writep2 (res->sVal2[s][gofw_Cor], res->pVal2[s][gofw_Cor]);+      }+      break;++   case smultin_CollPoissonSparse:+      /* The sum of N Poisson random variables is also a Poisson r. v. */+      printf ("POISSON approximation                 :\n");+      /* "Value of N * EColl : "); num_WriteD (N * EColl, 11, 2, 2); */+      printf ("Expected number of collisions = N*Mu  : ");+      num_WriteD (N * Esperance, 11, 2, 2);+      printf ("\nObserved number of collisions         : %8ld\n",+         (long) res->NbCollisions);+      gofw_Writep1 (res->pColl);+      break;++   case smultin_CollPoissonDense:+      /* The sum of N Poisson random variables is also a Poisson r. v. */+      printf ("POISSON approximation                 :\n"+              "Expected number of empty cells = N*Mu : ");+      num_WriteD (N * Esperance, 18, 2, 2);+#ifdef USE_LONGLONG+      printf ("\nObserved number of empty cells        : %15" PRIuLEAST64 "\n",+              res->NbCells[0]);+#else+      printf ("\nObserved number of empty cells        : %15.0f\n",+              res->NbCells[0]);+#endif+      gofw_Writep1 (res->pColl);+      break;++   default:;+      util_Error ("smultin_WriteResCollOver:  IMPOSSIBLE CASE");+      break;+   }+++   if (swrite_Collectors)+      statcoll_Write (res->Collector[s], 5, 14, 2, 1);++   printf ("-----------------------------\n"+      "Total number of cells containing j balls\n\n");+   for (j = 0; j <= smultin_MAXB / 2; j++) {+      printf ("  j = %2d", j);+#ifdef USE_LONGLONG+      printf ("                              : %16" PRIuLEAST64 "\n",+              res->NbCells[j]);+#else+      printf ("                              : %16.0f\n", res->NbCells[j]);+#endif+   }+   printf ("\n");+}+++/*=======================================================================*/++static void OverDenseGenere (+   unif01_Gen *gen, +   smultin_Res *res, +   long n,                    /* Number of balls */+   int r,+   long d,                    /* Division of 1-dim interval */+   int t,                     /* Dimension */+   long k,                    /* Number of urns in t dimensions */+   long k1                    /* Number of urns in t - 1 dimensions */+   )+/*+ * Generate the n balls for smultin_MultinomialOver in the dense+ * case, and fill the counters Count and Count1+ */+{+   long element;+   long Indice;+   long j;+   long Premier[MAX_DIM];+   long *Count = res->Count;      /* Counters in t dimensions */+   long *Count1 = res->Count1;    /* Counters in t - 1 dimensions */+   smultin_CellType *Nb = res->Nb;++   util_Assert (t < MAX_DIM, "OverDenseGenere:   t > 64");+   for (j = 1; j <= res->NbSize; j++)+      Nb[j] = 0;+   Nb[0] = k;+   for (j = 0; j <= k; j++)+      Count[j] = 0;+   for (j = 0; j <= k1; j++)+      Count1[j] = 0;++   /* Generation of the first (t - 1) random numbers for the first tuple. */+   /* We shall keep them in the array Premier[] since the sequence of     */+   /* generated numbers must be circular. They will be used to build the  */+   /* last t - 1 tuples. Here, tuples are balls or points.                */+   Indice = 0;+   for (j = 1; j < t; j++) {+      element = unif01_StripL (gen, r, d);+      Premier[j] = element;+      /* Shift tuple by s bits and insert new element */+      Indice = Indice * d + element;+   }++   /* Generation of the first n - (t - 1) tuples */+   for (j = 1; j <= n - (t - 1); j++) {+      Indice %= k1;+      ++Count1[Indice];+      Indice = Indice * d + unif01_StripL (gen, r, d);+      ++Count[Indice];+   }++   /* Generation of the last (t - 1) tuples. Use the elements of Premier */+   for (j = 1; j < t; j++) {+      Indice %= k1;+      ++Count1[Indice];+      Indice = Indice * d + Premier[j];+      ++Count[Indice];+   }+}+++/*=======================================================================*/++static void OverHashGenere (+   unif01_Gen *gen, +   smultin_Res *res, +   long n,                    /* Number of balls */+   int r,+   smultin_CellType dLR,      /* Parameter d */+   int t,                     /* Dimension */+   long Hache1,               /* Size of hashing table in t dimensions */+   long Hache11,              /* Size of hashing table in t - 1 dimensions */+   smultin_CellType k,        /* Number of urns in t dimensions */+   smultin_CellType k1,       /* Number of urns in t - 1 dimensions */+   long *CoMax,               /* Max number of balls in any cell in t dim. */ +   long *CoMax1               /* Max number of balls in any cell in t-1 dim. */+   )+/*+ * Generate the n balls for smultin_MultinomialOver in the sparse+ * case, and fill the counters. We use hashing.+ */+{+   long j, tem;+   long d = dLR;+   smultin_CellType Indice;+   smultin_CellType element;+   double UnSurHache1;+   double UnSurHache11;+   double UnSurk1;+   smultin_CellType Premier[MAX_DIM];+   long *Count = res->Count;      /* Counters in t dimensions */+   long *Count1 = res->Count1;    /* Counters in t - 1 dimensions */+   smultin_CellType *Cell = res->Cell; /* Cell numbers in t dimensions */+   smultin_CellType *Cell1 = res->Cell1; /* Cell numbers in t - 1 dimensions */+   smultin_CellType *Nb = res->Nb;+   smultin_CellType *Nb1 = res->Nb1;++   util_Assert (t < MAX_DIM, "OverHashGenere:   t > 64");+   UnSurk1 = 1.0 / k1;+   UnSurHache1 = 1.0 / Hache1;+   UnSurHache11 = 1.0 / Hache11;++   for (j = 0; j <= Hache1; j++) {+      Count[j] = 0;+#ifdef USE_LONGLONG+      Cell[j] = MASK64;           /* Empty cells */+#else+      Cell[j] = -1.0;             /* Empty cells */+#endif+   }+   for (j = 0; j <= Hache11; j++) {+      Count1[j] = 0;+#ifdef USE_LONGLONG+      Cell1[j] = MASK64;          /* Empty cells */+#else+      Cell1[j] = -1.0;            /* Empty cells */+#endif+   }+   for (j = 1; j <= res->NbSize; j++)+      Nb[j] = 0;+   for (j = 1; j <= res->Nb1Size; j++)+      Nb1[j] = 0;+   Nb[0] = k;+   Nb1[0] = k1;+   *CoMax = 0;+   *CoMax1 = 0;++   /* Generation of the first (t - 1) elements of the first tuple. We shall+      keep them in array Premier[] since the sequence of generated numbers+      must be circular. They will be used to obtain the last t - 1 tuples.+      When we generate a random number, we keep s bits and they become the+      least significant element of the tuple. We then shift the elements so+      that the most significant element is dropped. The tuples are balls. */++   /* Generate the first (t - 1) components of the first tuple (ball) */+   Indice = 0;+   for (j = 1; j < t; j++) {+      element = unif01_StripL (gen, r, d);+      Premier[j] = element;+      /* Shift tuple by s bits and insert new element */+      Indice = Indice * dLR + element;+   }++   /* Generation of the first n - (t - 1) tuples */+   for (j = 1; j <= n - (t - 1); j++) {+      /* Operation % k1 */+#ifdef USE_LONGLONG+      Indice %= k1;+#else+      tem = Indice * UnSurk1;+      Indice -= k1 * tem;+#endif+      UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+      Indice = Indice * dLR + unif01_StripL (gen, r, d);+      UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+   }++   /* Generate the last (t - 1) tuples. We use the elements of Premier[] */+   for (j = 1; j < t; j++) {+#ifdef USE_LONGLONG+      Indice %= k1;+#else+      tem = Indice * UnSurk1;+      Indice -= k1 * tem;+#endif+      UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+      Indice = Indice * dLR + Premier[j];+      UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+   }+}+++/*=======================================================================*/++static void OverDenseGenereBits (+   unif01_Gen *gen, +   smultin_Res *res, +   long n,                    /* Number of balls */+   int r,                     /* Drop first r bits of each random number */+   int L,                     /* Cells numbered with L bits */+   int s,                     /* Take s bits of each random number */+   long k,                    /* Number of urns in L dimensions */+   long k1                    /* Number of urns in L - 1 dimensions */+   )+/*+ * Generate the n balls for smultin_MultinomialBitsOver in the dense+ * case, and fill the counters Count and Count1+ */+{+   int j;+   long i;+   unsigned long Premier[MAX_DIM];+   long *Count = res->Count;      /* Counters in L dimensions */+   long *Count1 = res->Count1;    /* Counters in L - 1 dimensions */+   smultin_CellType *Nb = res->Nb;++   util_Assert (L < MAX_DIM, "OverDenseGenereBits:   L > 64");+   for (i = 1; i <= res->NbSize; i++)+      Nb[i] = 0;+   Nb[0] = k;+   for (i = 0; i <= k; i++)+      Count[i] = 0;+   for (i = 0; i <= k1; i++)+      Count1[i] = 0;++   if (L + s <= 32) {+      const unsigned long MASK = num_TwoExp[L] - 1.0;+      const unsigned long MASK1 = num_TwoExp[L - 1] - 1.0;+      const int t = (L - 1) / s + 1;+      unsigned long Z, Z0;+      int b;++      /* Generation of the first t*s random bits for the first tuple.  */+      /* We shall keep them in Premier since the sequence of generated */+      /* bits will be circular. */+      Z0 = 0;+      for (j = 0; j < t; j++) {+         Z0 <<= s;+         Premier[j] = unif01_StripB (gen, r, s);+         Z0 |= Premier[j];+      }++      /* Generation of other bits: main loop */+      for (i = 0; i < (n - t * s - 1) / s; i++) {+         Z = Z0 = (Z0 << s) | unif01_StripB (gen, r, s);+         for (j = 0; j < s; j++) {+            ++Count1[Z & MASK1];+            ++Count[Z & MASK];+            Z >>= 1;+         }+      }++      /* Generation of the last b random bits */+      Z0 = (Z0 << s) | unif01_StripB (gen, r, s);+      b = n % s;+      if (b)+         Z0 >>= (s - b);+      else+         b = s;++      Z = Z0;+      for (j = 0; j < b; j++) {+         ++Count1[Z & MASK1];+         ++Count[Z & MASK];+         Z >>= 1;+      }++      /* Must do last few bits using circular overlap with Premier */+      for (i = 0; i < t; i++) {+         Z = Z0 = (Z0 << s) | Premier[i];+         for (j = 0; j < s; j++) {+            ++Count1[Z & MASK1];+            ++Count[Z & MASK];+            Z >>= 1;+         }+      }+      return;+   }++#ifndef USE_LONGLONG+   util_Error ("OverDenseGenereBits:   L + s > 32");+#else++   /* ---------------------------------------------------------- */+   if (L + s <= 64) {+      const ulonglong MASK = num_TwoExp[L] - 1.0;+      const ulonglong MASK1 = num_TwoExp[L - 1] - 1.0;+      const int t = (L - 1) / s + 1;+      ulonglong Z, Z0;+      int b;++      /* Generation of the first t*s random bits */+      Z0 = 0;+      for (j = 0; j < t; j++) {+         Z0 <<= s;+         Premier[j] = unif01_StripB (gen, r, s);+         Z0 |= Premier[j];+      }++      /* Generation of the other random bits: main loop */+      for (i = 0; i < (n - t * s - 1) / s; i++) {+         Z = Z0 = (Z0 << s) | unif01_StripB (gen, r, s);+         for (j = 0; j < s; j++) {+            ++Count1[Z & MASK1];+            ++Count[Z & MASK];+            Z >>= 1;+         }+      }++      /* Generation of the last b random bits */+      Z0 = (Z0 << s) | unif01_StripB (gen, r, s);+      b = n % s;+      if (b)+         Z0 >>= s - b;+      else+         b = s;++      Z = Z0;+      for (j = 0; j < b; j++) {+         ++Count1[Z & MASK1];+         ++Count[Z & MASK];+         Z >>= 1;+      }++      /* Must do last few bits using circular overlap with Premier */+      for (i = 0; i < t; i++) {+         Z = Z0 = (Z0 << s) | Premier[i];+         for (j = 0; j < s; j++) {+            ++Count1[Z & MASK1];+            ++Count[Z & MASK];+            Z >>= 1;+         }+      }+      return;++      /* ---------------------------------------------------------- */+   } else {                       /* L + s > 64 */++      const ulonglong MASK = num_TwoExp[L] - 1.0;+      const ulonglong MASK1 = num_TwoExp[L - 1] - 1.0;+      const int t = (L - 1) / s + 1;+      const int q1 = 64 - L;+      const int q2 = s % q1;+      const int t2 = s / q1;+      ulonglong Z, Z0;+      unsigned long Bloc;+      int k, b;++      /* Generation of the first t*s random bits */+      Z0 = 0;+      for (j = 0; j < t; j++) {+         Z0 <<= s;+         Premier[j] = unif01_StripB (gen, r, s);+         Z0 |= Premier[j];+      }++      /* Generation of bits: main loop */+      for (i = 0; i < (n - t * s - 1) / s; i++) {+         Bloc = unif01_StripB (gen, r, s);++         /* Since L + s overflows a ulonglong, process a s-bit block in */+         /* t2 subblocks of q1 bits and one last subblock of q2 bits.   */+         for (k = 1; k <= t2; k++) {+            Z = Z0 = (Z0 << q1) | (Bloc >> (q2 + (t2 - k) * q1));+            for (j = 0; j < q1; j++) {+               ++Count1[Z & MASK1];+               ++Count[Z & MASK];+               Z >>= 1;+            }+         }+         Z = Z0 = (Z0 << q2) | Bloc;+         for (j = 0; j < q2; j++) {+            ++Count1[Z & MASK1];+            ++Count[Z & MASK];+            Z >>= 1;+         }+      }++      /* Generation of the last b random bits */+      Bloc = unif01_StripB (gen, r, s);+      b = n % s;+      if (0 == b)+         b = s;+      Bloc >>= s - b;+      {+         const int q3 = b % q1;+         const int t3 = b / q1;+         for (k = 1; k <= t3; k++) {+            Z = Z0 = (Z0 << q1) | (Bloc >> (q3 + (t3 - k) * q1));+            for (j = 0; j < q1; j++) {+               ++Count1[Z & MASK1];+               ++Count[Z & MASK];+               Z >>= 1;+            }+         }+         Z = Z0 = (Z0 << q3) | Bloc;+         for (j = 0; j < q3; j++) {+            ++Count1[Z & MASK1];+            ++Count[Z & MASK];+            Z >>= 1;+         }+      }++      /* Must do last few bits using circular overlap with Premier */+      for (i = 0; i < t; i++) {+         Bloc = Premier[i];+         for (k = 1; k <= t2; k++) {+            Z = Z0 = (Z0 << q1) | (Bloc >> (q2 + (t2 - k) * q1));+            for (j = 0; j < q1; j++) {+               ++Count1[Z & MASK1];+               ++Count[Z & MASK];+               Z >>= 1;+            }+         }+         Z = Z0 = (Z0 << q2) | Bloc;+         for (j = 0; j < q2; j++) {+            ++Count1[Z & MASK1];+            ++Count[Z & MASK];+            Z >>= 1;+         }+      }+      return;+   }+#endif+}+++/*=======================================================================*/++static void OverHashGenereBits (+   unif01_Gen *gen, +   smultin_Res *res, +   long n,                    /* Number of balls */+   int r,+   int L,                     /* Dimension */+   int s,+   long Hache1,               /* Size of hashing table in t dimensions */+   long Hache11,              /* Size of hashing table in t - 1 dimensions */+   smultin_CellType k,        /* Number of urns in t dimensions */+   smultin_CellType k1,       /* Number of urns in t - 1 dimensions */+   long *CoMax,               /* Max number of balls in any cell in t dim. */ +   long *CoMax1               /* Max number of balls in any cell in t-1 dim. */+   )+/*+ * Generate the n balls for smultin_MultinomialOver in the sparse+ * case, and fill the counters. We use hashing.+ */+{+   int j;+   long i;+   unsigned long Premier[MAX_DIM];+   smultin_CellType Indice;+   double UnSurHache1;+   double UnSurHache11;++   util_Assert (L < MAX_DIM, "OverHashGenereBits:   L > 64");+   UnSurHache1 = 1.0 / Hache1;+   UnSurHache11 = 1.0 / Hache11;++   for (j = 0; j <= Hache1; j++) {+      res->Count[j] = 0;+#ifdef USE_LONGLONG+      res->Cell[j] = MASK64;      /* Empty cells */+#else+      res->Cell[j] = -1.0;        /* Empty cells */+#endif+   }+   for (j = 0; j <= Hache11; j++) {+      res->Count1[j] = 0;+#ifdef USE_LONGLONG+      res->Cell1[j] = MASK64;     /* Empty cells */+#else+      res->Cell1[j] = -1.0;       /* Empty cells */+#endif+   }+   for (j = 1; j <= res->NbSize; j++)+      res->Nb[j] = 0;+   for (j = 1; j <= res->Nb1Size; j++)+      res->Nb1[j] = 0;+   res->Nb[0] = k;+   res->Nb1[0] = k1;+   *CoMax = 0;+   *CoMax1 = 0;++   if (L + s <= 32) {+      const unsigned long MASK = num_TwoExp[L] - 1.0;+      const unsigned long MASK1 = num_TwoExp[L - 1] - 1.0;+      const int t = (L - 1) / s + 1;+      unsigned long Z, Z0, b;++      /* Generation of the first t*s random bits for the first tuple. */+      /* We shall keep them in Premier since the sequence of */+      /* generated bits will be circular. */+      Z0 = 0;+      for (j = 0; j < t; j++) {+         Z0 <<= s;+         Premier[j] = unif01_StripB (gen, r, s);+         Z0 |= Premier[j];+      }++      /* Generation of all other bits: main loop */+      for (i = 0; i < (n - t * s - 1) / s; i++) {+         Z = Z0 = (Z0 << s) | unif01_StripB (gen, r, s);+         for (j = 0; j < s; j++) {+            Indice = Z & MASK1;+            UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+            Indice = Z & MASK;+            UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+            Z >>= 1;+         }+      }++      /* Generation of the last b random bits */+      Z0 = (Z0 << s) | unif01_StripB (gen, r, s);+      b = n % s;+      if (b)+         Z0 >>= (s - b);+      else+         b = s;++      Z = Z0;+      for (j = 0; j < (int) b; j++) {+         Indice = Z & MASK1;+         UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+         Indice = Z & MASK;+         UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+         Z >>= 1;+      }++      /* Must do last few bits using circular overlap with Premier */+      for (i = 0; i < t; i++) {+         Z = Z0 = (Z0 << s) | Premier[i];+         for (j = 0; j < s; j++) {+            Indice = Z & MASK1;+            UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+            Indice = Z & MASK;+            UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+            Z >>= 1;+         }+      }+      return;+   }++   /* ---------------------------------------------------------- */+#ifndef USE_LONGLONG+   util_Error ("OverHashGenereBits:   L + s > 32");+#else++   if (L + s <= 64) {+      const ulonglong MASK = num_TwoExp[L] - 1.0;+      const ulonglong MASK1 = num_TwoExp[L - 1] - 1.0;+      const int t = (L - 1) / s + 1;+      ulonglong Z, Z0, b;++      /* Generation of the first t*s random bits */+      Z0 = 0;+      for (j = 0; j < t; j++) {+         Z0 <<= s;+         Premier[j] = unif01_StripB (gen, r, s);+         Z0 |= Premier[j];+      }++      /* Generation of the other random bits: main loop */+      for (i = 0; i < (n - t * s - 1) / s; i++) {+         Z = Z0 = (Z0 << s) | unif01_StripB (gen, r, s);+         for (j = 0; j < s; j++) {+            Indice = Z & MASK1;+            UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+            Indice = Z & MASK;+            UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+            Z >>= 1;+         }+      }++      /* Generation of the last b random bits */+      Z0 = (Z0 << s) | unif01_StripB (gen, r, s);+      b = n % s;+      if (b)+         Z0 >>= (s - b);+      else+         b = s;++      Z = Z0;+      for (j = 0; j < (int) b; j++) {+         Indice = Z & MASK1;+         UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+         Indice = Z & MASK;+         UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+         Z >>= 1;+      }++      /* Must do last few bits using circular overlap with Premier */+      for (i = 0; i < t; i++) {+         Z = Z0 = (Z0 << s) | Premier[i];+         for (j = 0; j < s; j++) {+            Indice = Z & MASK1;+            UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+            Indice = Z & MASK;+            UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+            Z >>= 1;+         }+      }+      return;++      /* ---------------------------------------------------------- */+   } else {                       /* L + s > 64 */++      const ulonglong MASK = num_TwoExp[L] - 1.0;+      const ulonglong MASK1 = num_TwoExp[L - 1] - 1.0;+      const int t = (L - 1) / s + 1;+      const int q1 = 64 - L;+      const int t2 = s / q1;+      const int q2 = s % q1;+      ulonglong Z, Z0;+      unsigned long Bloc;+      int k, b;++      /* Generation of the first t*s random bits */+      Z0 = 0;+      for (j = 0; j < t; j++) {+         Z0 <<= s;+         Premier[j] = unif01_StripB (gen, r, s);+         Z0 |= Premier[j];+      }++      /* Generation of the other random bits: main loop */+      for (i = 0; i < (n - t * s - 1) / s; i++) {+         Bloc = unif01_StripB (gen, r, s);++         /* Since L + s overflows a ulonglong, process a s-bit block in */+         /* t2 subblocks of q1 bits and one last subblock of q2 bits.  */+         for (k = 1; k <= t2; k++) {+            Z = Z0 = (Z0 << q1) | (Bloc >> (q2 + (t2 - k) * q1));+            for (j = 0; j < q1; j++) {+               Indice = Z & MASK1;+               UpdateCountHash (res, Indice, Hache11, UnSurHache11,+                  CoMax1, TRUE);+               Indice = Z & MASK;+               UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax,+                  FALSE);+               Z >>= 1;+            }+         }+         Z = Z0 = (Z0 << q2) | Bloc;+         for (j = 0; j < q2; j++) {+            Indice = Z & MASK1;+            UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+            Indice = Z & MASK;+            UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+            Z >>= 1;+         }+      }++      /* Generation of the last b random bits */+      b = n % s;+      Bloc = unif01_StripB (gen, r, s);+      if (0 == b)+         b = s;+      Bloc >>= s - b;++      {+         const int q3 = b % q1;+         const int t3 = b / q1;+         for (k = 1; k <= t3; k++) {+            Z = Z0 = (Z0 << q1) | (Bloc >> (q3 + (t3 - k) * q1));+            for (j = 0; j < q1; j++) {+               Indice = Z & MASK1;+               UpdateCountHash (res, Indice, Hache11, UnSurHache11,+                  CoMax1, TRUE);+               Indice = Z & MASK;+               UpdateCountHash (res, Indice, Hache1, UnSurHache1,+                  CoMax, FALSE);+               Z >>= 1;+            }+         }+         Z = Z0 = (Z0 << q3) | Bloc;+         for (j = 0; j < q3; j++) {+            Indice = Z & MASK1;+            UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+            Indice = Z & MASK;+            UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+            Z >>= 1;+         }+      }++      /* Must do last few bits using circular overlap with Premier */+      for (i = 0; i < t; i++) {+         Bloc = Premier[i];+         for (k = 1; k <= t2; k++) {+            Z = Z0 = (Z0 << q1) | (Bloc >> (q2 + (t2 - k) * q1));+            for (j = 0; j < q1; j++) {+               Indice = Z & MASK1;+               UpdateCountHash (res, Indice, Hache11, UnSurHache11,+                  CoMax1, TRUE);+               Indice = Z & MASK;+               UpdateCountHash (res, Indice, Hache1, UnSurHache1,+                  CoMax, FALSE);+               Z >>= 1;+            }+         }+         Z = Z0 = (Z0 << q2) | Bloc;+         for (j = 0; j < q2; j++) {+            Indice = Z & MASK1;+            UpdateCountHash (res, Indice, Hache11, UnSurHache11, CoMax1, TRUE);+            Indice = Z & MASK;+            UpdateCountHash (res, Indice, Hache1, UnSurHache1, CoMax, FALSE);+            Z >>= 1;+         }+      }+      return;+   }+#endif+}+++/*=======================================================================*/++static void MultinomOver (unif01_Gen * gen, smultin_Param * par,+   smultin_Res * res, long N, long n, int r, long d, int t, lebool Sparse,+   smultin_CellType k, smultin_CellType k1, char *TestName,+   chrono_Chrono *Timer, lebool BitFlag)+{+   long Seq;+   smultin_CellType dLR = d;+   double nLR = n;+   double NbExp;              /* Expected number per cell in t dimensions */+   double NbExp1;             /* Expected number per cell in t - 1 dim. */+   double EColl;              /* Approx. expected number of collisions */+   DeltaIndex s;+   long Hache1, Hache11;      /* Hashing modules */+   long CoMax1;               /* Max number of balls in any cell: t-1 dim. */+   long CoMax;                /* Max number of balls in any cell: t dim. */+   double X, X0, X1;          /* Statistics */+   double Esperance;          /* Expected value of number of collisions */+   double StandDev;           /* Standard deviation of number of collisions */+   double V[1];               /* Number of degrees of freedom for ChiSquare */+   double SumX2[smultin_MAX_DELTA];+   double SumX[smultin_MAX_DELTA];+   double X0Pre[smultin_MAX_DELTA];+   lebool localRes = FALSE;++   NbExp = (double) n / k;+   NbExp1 = (double) n / k1;+   EColl = nLR * nLR / (2.0 * k);+   if (par == NULL)+      par = &smultin_ParamDefault;+   if (res == NULL) {+      localRes = TRUE;+      res = smultin_CreateRes (par);+   } else+      /* Clean memory from a previous call */+      CleanPD (res);++   res->NbCellsTotal = k;+   res->Over = TRUE;+   InitRes (par, res, N);+   InitPowDiv (par, res, N, Sparse, n, k - k1);+   if (swrite_Basic) {+      if (BitFlag)+         /* Here t stand for s, d for L */+         WriteDataMNBits (gen, par, res, TestName, N, n, r, d, t, Sparse, k,+                          TRUE);+      else+         WriteDataPowDiv (gen, par, res, TestName, N, n, r, d, t, Sparse, k);+   }+   for (s = 0; s < par->NbDelta; s++) {+      if (fabs (par->ValDelta[s] + 1.0) < EPS_LAM) {+         /* CollisionOver test */+         InitCollOver (res, n, k, d, t, &Esperance, &StandDev);+         if (swrite_Basic)+            WriteDataCollOver (res, n, k, Esperance, StandDev);+      }+   }+   for (s = 0; s < par->NbDelta; s++) {+      SumX[s] = 0.0;+      SumX2[s] = 0.0;+      X0Pre[s] = 0.0;+   }+   CalcTabFj (par, res, Sparse, (double) k, NbExp);+   if (res->Hashing) {+      Hache1 = tables_HashPrime (n, smultin_env.HashLoad);+      if ((unsigned) Hache1 > k1)+         Hache11 = k1;+      else+         Hache11 = Hache1;+      res->Cell = util_Calloc ((size_t) Hache1 + 2, sizeof (smultin_CellType));+      res->Cell1 = util_Calloc ((size_t) Hache11 + 2,+         sizeof (smultin_CellType));+   } else {+      Hache1 = k;+      Hache11 = k1;+   }+   res->CountSize = Hache1;+   res->Count1Size = Hache11;+   res->Count = util_Calloc ((size_t) Hache1 + 2, sizeof (long));+   res->Count1 = util_Calloc ((size_t) Hache11 + 2, sizeof (long));+   res->NbSize = res->Nb1Size = 8000;+   res->Nb = util_Calloc ((size_t) res->NbSize + 2, sizeof (smultin_CellType));+   res->Nb1 = util_Calloc ((size_t) res->Nb1Size + 2,+      sizeof (smultin_CellType));++   /* Generate the points or balls */+   for (Seq = 1; Seq <= N; Seq++) {+      if (BitFlag) {+         /* Here, d stands for L, and t for s */+         if (res->Hashing) {+            OverHashGenereBits (gen, res, n, r, d, t, Hache1, Hache11, k, k1,+               &CoMax, &CoMax1);+         } else {+            OverDenseGenereBits (gen, res, n, r, d, t, Hache1, Hache11);+         }+      } else {+         if (res->Hashing) {+            OverHashGenere (gen, res, n, r, dLR, t, Hache1, Hache11, k, k1,+               &CoMax, &CoMax1);+         } else {+            OverDenseGenere (gen, res, n, r, d, t, Hache1, Hache11);+         }+      }++      if (swrite_Counters) {+         if (res->Hashing) {+#ifdef USE_LONGLONG+            tables_WriteTabULL (res->Nb, 0, CoMax, 5, 12,+               "Observed numbers in res->Nb");+            tables_WriteTabULL (res->Nb1, 0, CoMax1, 5, 12,+               "Observed numbers in res->Nb1");+#else+            tables_WriteTabD (res->Nb, 0, CoMax, 5, 12, 0, 0,+               "Observed numbers in res->Nb");+            tables_WriteTabD (res->Nb1, 0, CoMax1, 5, 12, 0, 0,+               "Observed numbers in res->Nb1");+#endif+         } else if (!Sparse) {+            tables_WriteTabL (res->Count, 0, res->CountSize - 1, 5,+               10, "Observed numbers in res->Count");+            tables_WriteTabL (res->Count1, 0, res->Count1Size - 1, 5,+               10, "Observed numbers in res->Count1");+         }+      }++      /* The balls have been generated; now compute the statistics */+      for (s = 0; s < par->NbDelta; s++) {+         /* Compute the stat. X */+         if (res->Hashing) {+            CalcPoDiEqHache (par, res, s, NbExp, res->Nb, CoMax, TRUE, &X);++         } else if (res->flagTab) {+            CalcPowDivEqual (par, res, s, NbExp,+               res->Count, 0, Hache1 - 1, TRUE, &X);++         } else {+            CalcPowDivEqual (par, res, s, NbExp,+               res->Count, 0, Hache1 - 1, FALSE, &X);+         }++         if (fabs (par->ValDelta[s] + 1.0) < EPS_LAM && Esperance >= 0.0) {+            /* CollisionOver test */+            switch ((unsigned) res->CollApprox) {+            case smultin_CollPoissonDense: /* Number of empty cells */+               X0 = k + X - nLR;+               break;+            case smultin_CollPoissonSparse: /* Number of collisions */+               X0 = X;+               break;+            case smultin_CollNormal: /* Standardized number of collisions */+               X0 = (X - Esperance) / StandDev;+               break;+            default:+               util_Error+                  ("smultin_MultinomialOver: Computing X0 with CollNotInit");+               break;+            }+            res->NbCollisions += X;+            res->Nb[0] = k + X - nLR;+            statcoll_AddObs (res->Collector[s], X0);+            CalcNbCells (par, res, 0, Hache1 - 1, CoMax);++         } else {+            /* In the case delta = 1, X-X1 is approx. a chi-square with+               k - k1 degrees of freedom, or a normal in the sparse case */+            /* Compute X1 */+            if (res->Hashing) {+               CalcPoDiEqHache (par, res, s, NbExp1, res->Nb1,+                  CoMax1, FALSE, &X1);+            } else {+               CalcPowDivEqual (par, res, s, NbExp1,+                  res->Count1, 0, Hache11 - 1, FALSE, &X1);+            }+            X0 = (X - X1 - res->Mu[s]) / res->Sigma[s];+            statcoll_AddObs (res->Collector[s], X0);+            if (!Sparse)+               X0 = (X0 - k + k1) / sqrt (2.0 * (k - k1));+            /* Now, X0 is standardized, with mean 0 and variance 1.  */+         }++         /* The following is to compute the mean and correlation */+         SumX[s] += X0;+         SumX2[s] += X0 * X0Pre[s];+         X0Pre[s] = X0;+      }+   }++   /* For now, we understand only the cases delta = 1 and Collision */+   for (s = 0; s < par->NbDelta; s++) {+      statcoll_Collector *Q = res->Collector[s];+      double racN = sqrt ((double) N);++      if (par->ValDelta[s] > -1.0 + EPS_LAM) {+         /* Not Collisions test */+         if (Sparse) {+            util_Warning (fabs (par->ValDelta[s] - 1.0) > EPS_LAM,+  "The theoretical distribution for the overlapping case\nis known only for Delta = 1");+            gofw_ActiveTests1 (Q->V, Q->NObs, wdist_Normal,+               (double *) NULL, res->sVal2[s], res->pVal2[s]);+         } else {+            V[0] = k - k1;+            gofw_ActiveTests1 (Q->V, Q->NObs, wdist_ChiSquare, V,+               res->sVal2[s], res->pVal2[s]);+         }+         /* Compute the mean, the correlation, and their p-values */+         if (Q->NObs > 1) {+            res->sVal2[s][gofw_Mean] = SumX[s] / racN;+            res->pVal2[s][gofw_Mean] = fbar_Normal1 (res->sVal2[s][gofw_Mean]);+            res->sVal2[s][gofw_Cor] = racN * SumX2[s] / (N - 1);+            res->pVal2[s][gofw_Cor] = fbar_Normal1 (res->sVal2[s][gofw_Cor]);+         }+         if (swrite_Basic) {+            WriteResultsPowDiv (par, res, s, N, EColl, k - k1, Sparse,+               res->Mu[s]);+         }++      } else if (fabs (par->ValDelta[s] + 1.0) < EPS_LAM) {+         /* Collisions test */+         CalcResCollOver (res, s, N, Esperance, SumX[s], SumX2[s]);+         if (swrite_Basic) {+            WriteResCollOver (par, res, s, N, EColl, Esperance);+         }+      }+   }+   if (swrite_Basic)+      swrite_Final (gen, Timer);++   if (localRes)+      smultin_DeleteRes (res);+}+++/*=======================================================================*/++void smultin_MultinomialOver (unif01_Gen * gen, smultin_Param * par,+   smultin_Res * res, long N, long n, int r, long d, int t, lebool Sparse)+{+   int i;+   smultin_CellType k1;       /* Number of urns in t - 1 dimensions */+   smultin_CellType k;        /* Number of urns in t dimensions */+   double NbExp;              /* Expected number per cell in t dimensions */+   chrono_Chrono *Timer;+   char *TestName = "smultin_MultinomialOver test";++   Timer = chrono_Create ();+   if (NULL == par)+      par = &smultin_ParamDefault;+   k1 = 1;+   for (i = 1; i < t; i++)+      k1 *= d;+   k = k1 * d;+   NbExp = (double) n / k;+   util_Assert (n > 4, "smultin_MultinomialOver:   n <= 4");+   util_Assert (t > 1, "smultin_MultinomialOver:   t < 2");+   if (par->GenerCell != smultin_GenerCellPermut)+      util_Assert (d > 1, "smultin_MultinomialOver:   d <= 1");+   util_Assert (k <= smultin_env.Maxk,+      "smultin_MultinomialOver:   d^t > Maxk");+#ifndef USE_LONGLONG+   util_Assert (NbExp > 1.0 / num_TwoExp[31],+      "smultin_MultinomialOver:   NbExp <= 1/2^31");+#endif+   MultinomOver (gen, par, res, N, n, r, d, t, Sparse, k, k1,+                 TestName, Timer, FALSE);+   chrono_Delete (Timer);+}+++/*=======================================================================*/++void smultin_MultinomialBits (unif01_Gen *gen, smultin_Param *par,+   smultin_Res *res, long N, long n, int r, int s, int L, lebool Sparse)+{+/* + * Sparse:   normal approximation for Delta != -1.+ * Non sparse:  chi-square approximation.+ * Collisions test meaningfull only in Sparse case.+ */+   smultin_CellType k;            /* Number of cells */+   chrono_Chrono *Timer;+   char *TestName = "smultin_MultinomialBits test";++   Timer = chrono_Create ();+   k = num_TwoExp[L];+   if (NULL == par)+      par = &smultin_ParamDefault;+   if (L >= s) {+      long d = num_TwoExp[s];+      int t = L / s;+      if (swrite_Basic) {+         printf+            ("***********************************************************\n"+            "Test smultin_MultinomialBits calling smultin_Multinomial\n\n");+         printf ("   N = %2ld,  n = %2ld,  r = %1d", N, n, r);+         printf (",   s = %2d,   L = %2d,   Sparse = ", s, L);+         util_WriteBool (Sparse, 5);+         printf ("\n\n   Number of bits = n*L = %.0f\n\n\n", (double) n * L);+      }+      if ((t == 1) && (s > 30)) {+         util_Warning (TRUE, "smultin_MultinomialBits:   L = s  and  s > 30");+         return;+      }+      util_Assert (L % s == 0, "smultin_MultinomialBits:   L Mod s > 0");+      par->GenerCell = smultin_GenerCellSerial;+      smultin_Multinomial (gen, par, res, N, n, r, d, t, Sparse);+      return;+   }++   util_Assert (s % L == 0, "smultin_MultinomialBits:   s Mod L > 0");+   util_Assert (k <= smultin_env.Maxk,+      "smultin_MultinomialBits:   k > Maxk");+   util_Assert (n > 4, "smultin_MultinomialBits:   n <= 4");+#ifndef USE_LONGLONG+   util_Assert ((double) n / k > 1.0 / num_TwoExp[31],+      "smultin_MultinomialBits:   NbExp <= 1/2^31");+#endif+   Multinom (gen, par, res, N, n, r, L, s, Sparse, k, TestName, Timer, TRUE);+   chrono_Delete (Timer);+}+++/*=======================================================================*/++void smultin_MultinomialBitsOver (unif01_Gen * gen, smultin_Param * par,+   smultin_Res * res, long N, long n, int r, int s, int L, lebool Sparse)+{+   smultin_CellType k1;       /* Number of urns in L - 1 dimensions */+   smultin_CellType k;        /* Number of urns in L dimensions */+   double NbExp;              /* Expected number per cell in L dimensions */+   chrono_Chrono *Timer;+   char *TestName = "smultin_MultinomialBitsOver test";++   Timer = chrono_Create ();+   if (NULL == par)+      par = &smultin_ParamDefault;+   util_Assert (L <= 64, "smultin_MultinomialBitsOver:   L > 64");+   k1 = num_TwoExp[L - 1];+   k = num_TwoExp[L];+   NbExp = (double) n / k;+   util_Assert (n > 4, "smultin_MultinomialBitsOver:   n <= 4");+   util_Assert (L > 1, "smultin_MultinomialBitsOver:   L < 2");+   util_Assert (s > 0, "smultin_MultinomialBitsOver:   s < 1");+   util_Assert (k <= smultin_env.Maxk,+      "smultin_MultinomialBitsOver:   L too large");+#ifndef USE_LONGLONG+   util_Assert (NbExp > 1.0 / num_TwoExp[31],+      "smultin_MultinomialBitsOver:   NbExp <= 1/2^31");+#endif+   MultinomOver (gen, par, res, N, n, r, L, s, Sparse, k, k1,+                 TestName, Timer, TRUE);++   chrono_Delete (Timer);+}
+ cbits/testu/src/snpair.c view
@@ -0,0 +1,2635 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           snpair.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/+++#include "util.h"+#include "tables.h"+#include "chrono.h"+#include "num.h"+#include "num2.h"++#include "snpair.h"+#include "swrite.h"+#include "unif01.h"++#include "statcoll.h"+#include "fdist.h"+#include "fbar.h"+#include "fmass.h"+#include "gofs.h"+#include "gofw.h"++#include <math.h>+#include <limits.h>+#include <float.h>+#include <stddef.h>+#include <string.h>++#undef DEBUG+#ifdef DEBUG++#include <stdio.h>+/* Prints all the points */+#define TRACEP(n, name) { \+   FILE *f; \+   long i, j; \+   f = util_Fopen (name, "w"); \+   fprintf (f, "------------------------\n"); \+   for (i = 1; i <= n; i++) { \+      for (j = 1; j <= kk; j++) \+	fprintf (f, "%f    ", res->Points[1][i][j]); \+      fprintf (f, "\n"); \+   } \+}+#endif+++++/*---------------------------- extern variables ---------------------------*/++snpair_Envir snpair_env = {+   20, 30, 30, 1000+};++/* For now, we do not use it. Is used in the t modules */+long snpair_MaxNumPoints = LONG_MAX;++lebool snpair_TimeBB = FALSE;+lebool snpair_mNP2S_Flag = TRUE;+++++/*---------------------------- static variables ---------------------------*/++typedef struct {++   int L1;                     /* Change coordinate at each L1 recur-  */+                               /* sion level in FindClosePairs         */+   int L2;                     /* Same thing for CheckBoundary         */+   int kk;                     /* = k = Dimension                      */+   int pp;                     /* = p (L_p norm); p = 0 is sup norm    */+   int mm;                     /* = m = (number of kept distances)     */+   int mcd;                    /* Dimension of CloseDist[]             */+   double dlim1;               /* (m \mu2)^{1/k}                       */+   double dlim1p;              /* dlim1^p (when p > 0)                 */+   double dlim;                /* = max (dlim1, CloseDist[m]); search  */+                               /* for points at distance < dlim        */+   double dlimp;               /* = dlim^p (when p > 0)                */+   double pLR;                 /* = p                                  */+   double Invp;                /* 1/p; ( = 1 if p = 0)                 */+   int Maxnp;                  /* Max level of recursion               */+   lebool Torus;              /* TRUE if in Torus; FALSE if in cube   */+   lebool BBFlag;             /* TRUE if BickelBreimann test          */+   wdist_CFUNC FDistBB;        /* BickelBreimann CDF                   */++/* The largest distance for snpair_DistanceCPBitM: the largest number of+   equal bits for all components of a pair of points (all components of+   the pair have at least YLim identical bits) amongst all pairs. */+   int YLim;++} WorkType;+++/*------------------ Module variables for G+, G-, H+, H-  -----------------*/+/*+ * To compute the jumps in FDistGPlus, FDistGMinus, FDistHPlus, FDistHMinus+ */+++#if 0+static double t0;++#define xinf 1.0e50++static lebool GPlusFlag  = FALSE;+static lebool GMinusFlag = FALSE;+static lebool HPlusFlag  = FALSE;+static lebool HMinusFlag = FALSE;++static double GPlust0  = -xinf;    /* = t0 for GPlus  */+static double GMinust0 = -xinf;    /* = t0 for GMinus */+static double HPlust0  = -xinf;    /* = t0 for HPlus  */+static double HMinust0 = -xinf;    /* = t0 for HMinus */+static double GPlust1  = -xinf;    /* = t1 for GPlus  */+static double GMinust1 = -xinf;    /* = t1 for GMinus */+static double HPlust1  = -xinf;    /* = t1 for HPlus  */+static double HMinust1 = -xinf;    /* = t1 for HMinus */++static double *GPlusJumpX;         /* Position x of the jumps of G+       */+static double *GPlusJumpYBottom;   /* Value y left of the jumps of G+     */+static double *GPlusJumpYTop;      /* Value y right of the jumps of G+    */++static double *GMinusJumpX;        /* Similarly for G- */+static double *GMinusJumpYBottom;+static double *GMinusJumpYTop;++static double *HPlusJumpX;         /* Similarly for H+ */+static double *HPlusJumpYBottom;+static double *HPlusJumpYTop;++static double *HMinusJumpX;        /* Similarly for H- */+static double *HMinusJumpYBottom;+static double *HMinusJumpYTop;++static int GPlusNJump;             /* The number of jumps of G+ */+static int GMinusNJump;            /* The number of jumps of G- */+static int HPlusNJump;             /* The number of jumps of H+ */+static int HMinusNJump;            /* The number of jumps of H- */++#endif++/*------------------ Module variables for Bickel-Breiman test  ------------*/++static double BB2[132];+static double BB3[132];+static double BB4[43];+static double BB5[22];+++++++/*-------------------------------- functions ------------------------------*/++static void CopyPoints (snpair_PointType A[], snpair_PointType B[], long r,+   long s)+/*+ * Copies A[r..s] into B[r..s]+ */+{+   long i;+   for (i = r; i <= s; i++)+      B[i] = A[i];+}+++/*=========================================================================*/++void snpair_QuickSort (snpair_PointType A[], long l, long r, int c)+/*+ * Sort points of indices l to r using coordinate c as key. Exchange+ * pointers instead of points.+ */+{+   long j;+   long i;+   double pivot;+   snpair_PointType vec;+   i = l;+   j = r;+   pivot = A[(l + r) / 2][c];+   do {+      while (A[i][c] < pivot)+         ++i;+      while (pivot < A[j][c])+         --j;+      if (i <= j) {+         vec = A[i];+         A[i] = A[j];+         A[j] = vec;+         ++i;+         --j;+      }+   } while (i <= j);+   if (l < j)+      snpair_QuickSort (A, l, j, c);+   if (i < r)+      snpair_QuickSort (A, i, r, c);+}+++/*=========================================================================*/++void snpair_DistanceCP (snpair_Res * res, snpair_PointType P1,+   snpair_PointType P2)+/*+ * For ClosePairs, checks if the distance between P1 and P2 is < dlim.+ * If so, updates dlim, dlimp, and adds the new distance in the list+ * of shortest distances.+ */+{+   int i;+   double temp;+   double dist;+   double distp = 0.0;+   WorkType *work = res->work;++   for (i = 1; i <= work->kk; i++) {+      temp = P1[i] - P2[i];+      if (temp < 0.0)+         temp = -temp;+      if (work->Torus && temp > 0.5)+         temp = 1.0 - temp;+      if (work->pp == 0) {+         if (temp > distp)+            distp = temp;+      } else if (work->pp == 1)+         distp += temp;+      else if (work->pp == 2)+         distp += temp * temp;+      else+         distp += pow (temp, work->pLR);+      if (distp >= work->dlimp)+         return;+   }++#define NUM_JUMPS_LIM 50000+/* I put this arbitrary limit on the size of res->CloseDist because for bad+   generators, there will be many pairs of points with 0 distances between+   them, and res->CloseDist will otherwise eat up the whole memory. +   If the parameters N and m in ClosePairs should be such that +   N*m > NUM_JUMPS_LIM, then this limit will have to be increased. (RS) */++   if (distp < work->dlimp) {+      if (work->pp <= 1)+         dist = distp;+      else if (work->pp == 2)+         dist = sqrt (distp);+      else+         dist = pow (distp, work->Invp);+      if ((res->NumClose < work->mm ||+           res->CloseDist[res->NumClose] < work->dlim1) &&+          (res->NumClose < NUM_JUMPS_LIM)) {+         ++res->NumClose;         /* Complete the list of close pairs */+         if (res->NumClose >= work->mcd) {+            double *A;+            work->mcd *= 2;+            A = util_Realloc (res->CloseDist, (work->mcd + 1)*sizeof (double));+            if (A == NULL) {+               util_Warning (1, "Cannot realloc res->CloseDist");+            } else+            res->CloseDist = A;+         }+         util_Warning ((res->NumClose >= NUM_JUMPS_LIM) && swrite_Basic,+              "res->NumClose > 50000");+      }++      /* Insert the new distance in the sorted list */+      i = res->NumClose;+      while (i > 1 && dist < res->CloseDist[i - 1]) {+         --i;+         res->CloseDist[i + 1] = res->CloseDist[i];+      }+      res->CloseDist[i] = dist;++      if (res->NumClose == work->mm && res->CloseDist[work->mm] < work->dlim+         && work->dlim1 < work->dlim) {+         work->dlim = res->CloseDist[work->mm];+         if (work->dlim < work->dlim1) {+            work->dlim = work->dlim1;+            work->dlimp = work->dlim1p;+         } else if (work->pp <= 1)+            work->dlimp = work->dlim;+         else if (work->pp == 2)+            work->dlimp = work->dlim * work->dlim;+         else+            work->dlimp = pow (work->dlim, work->pLR);+      }+   }+}+++/*=========================================================================*/++void snpair_DistanceBB (snpair_Res * res, snpair_PointType P1,+   snpair_PointType P2)+/*+ * For Bickel-Breiman, checks whether the distance between P1 and P2, to the+ * power p, is less than P1[0] or P2[0]. If so, updates these values.+ */+{+   int i;+   double bound;+   double temp;+   double distp;+   WorkType *work = res->work;++   if (P2[0] > P1[0])+      bound = P2[0];+   else+      bound = P1[0];++   distp = 0.0;+   for (i = 1; i <= work->kk; i++) {+      temp = P1[i] - P2[i];+      if (temp < 0.0)+         temp = -temp;+      if (work->Torus && temp > 0.5)+         temp = 1.0 - temp;+      if (work->pp == 1)+         distp += temp;+      else if (work->pp == 2)+         distp += temp * temp;+      else if (work->pp == 0) {+         if (temp > distp)+            distp = temp;+      } else+         distp += pow (temp, work->pLR);+      if (distp >= bound)+         return;+   }++   if (distp < P1[0])+      P1[0] = distp;+   if (distp < P2[0])+      P2[0] = distp;+}+++/*=========================================================================*/++void snpair_VerifPairs0 (snpair_Res * res, snpair_PointType A[], long r,+   long s, int junk1, int junk2)+/*+ * Compute the distance between all pairs of points with indices in the+ * interval [r..s] for the array A; updates the distances for BB. We assume+ * the points are sorted with respect to coordinate c.+ */+{+   long i, j;+   for (i = r; i < s; i++) {+      for (j = i + 1; j <= s; j++) {+         res->Distance (res, A[i], A[j]);+      }+   }+}+++/*=========================================================================*/++void snpair_VerifPairs1 (snpair_Res * res, snpair_PointType A[], long r,+   long s, int np, int c)+/*+ * Compute the distance between all pairs of points with indices in the+ * interval [r..s] for the array A; updates dlim and dlimp if necessary.+ * We assume the points are sorted with respect to coordinate c.+ */+{+   long i, j;+   double high;+   WorkType *work = res->work;++   util_Assert (np <= work->Maxnp,+      "Calling snpair_VerifPairs1 with np > Maxnp");+   for (i = r; i <= s; i++) {+      /* util_Assert (r <= s, "Calling snpair_VerifPairs1 with r > s"); */++      /* Consider only points at distance <= dlim from A[i] with respect to+         coordinate c */+      high = A[i][c] + work->dlim;+      j = i + 1;+      while (j <= s && A[j][c] < high) {+         res->Distance (res, A[i], A[j]);+         ++j;+      }+      if (j > s && work->Torus && np <= work->kk) {+         high -= 1.0;+         j = r;+         while (j < i && A[j][c] < high) {+            /* util_Assert (i != j, "Calling distance with i=j in+               snpair_VerifPairs1"); */+            res->Distance (res, A[i], A[j]);+            ++j;+         }+      }+   }+}+++/*=========================================================================*/++static void dlimSlice (+   snpair_Res *res, +   snpair_PointType A[],+   long *r,+   long *imed,+   long *jmed,+   long *s,+   int c,+   lebool Tor+   )+/*+ * Let E1 = A [*r..*imed] and E2 = A [*jmed..*s] be two sets of points sorted+ * with respect to the c-th coordinate.+ * If Torus = FALSE, will reduce E1 to a slice of width dlim (in the direction+ * c) of the leftmost point of E2; and similarly for E2 with respect to the+ * rightmost point of E1 (always with respect to the c-th coordinate).+ * There will be thus a slice on each side of the boundary line.+ * If Torus = TRUE, we consider rather the points to the left of+ * (E1 + 1.0) as being close to those to the right of E2. This procedure+ * tries to decrease imed and to increase jmed.+ */+{+   long i;+   double temp;+   WorkType *work = res->work;++   if (*r > *imed || *jmed > *s)+      return;++#ifdef DEBUG+   printf ("ENTER dlimslice ");+   num_WriteD (work->dlim, 10, 5, 1);+   printf (" %5ld %5ld %5ld %5ld %3d  ", *r, *imed, *jmed, *s, c);+   util_WriteBool (Tor, 5);+   printf ("\n");+#endif++   if (Tor) {+      temp = A[*s][c] - 1.0;+      i = *r;+      while (i <= *imed && A[i][c] - temp < work->dlim)+         ++i;+      *imed = i - 1;+      temp = A[*r][c] + 1.0;+      i = *s;+      while (i >= *jmed && temp - A[i][c] < work->dlim)+         --i;+      *jmed = i + 1;++   } else {+      temp = A[*jmed][c];+      i = *imed;+      while (i >= *r && temp - A[i][c] < work->dlim)+         --i;+      *r = i + 1;+      temp = A[*imed][c];+      i = *jmed;+      while (i <= *s && A[i][c] - temp < work->dlim)+         ++i;+      *s = i - 1;+   }++#ifdef DEBUG+   printf ("EXIT dlimslice            ");+   printf (" %5ld %5ld %5ld %5ld\n", *r, *imed, *jmed, *s);+#endif+}+++/*=========================================================================*/++void snpair_MiniProc0 (snpair_Res * res, snpair_PointType T[], long r,+   long s, long u, long v, int junk1, int junk2)+/*+ * Call "res->Distance" for each point of T[r..s] with each point+ * of T[u..v].+ */+{+   long i, j;++   for (i = r; i <= s; i++)+      for (j = u; j <= v; j++)+         res->Distance (res, T[i], T[j]);+}+++/*=========================================================================*/++void snpair_MiniProc1 (snpair_Res * res, snpair_PointType T[], long r,+   long s, long u, long v, int np, int c)+/* + * Compute the distance between each point of the set E1 = T[r..s] and + * those of E2 = T[u..v]. We consider only the pairs for which the  + * differences between the c-th coordinate is <= dlim.                  + * Assume that the points of E1 and those of E2 are sorted with respect to+ * coordinate c. If we have the case of snpair_DistanceCP, updates dlim and+ * dlimp whenever a shorter value is found.+ */+{+   long inf;+   long l, k, j, i;+   double high, low;+   WorkType *work = res->work;++#ifdef DEBUG+   printf ("ENTER MiniProc1 ");+   num_WriteD (work->dlim, 10, 5, 1);+   printf (" %5ld %5ld %5ld %5ld    %3d\n", r, s, u, v, np);+   if (v < r)+      printf ("MiniProc1 with v < r !!!\n");+   util_Assert (np <= work->Maxnp, "MiniProc1:  np > Maxnp");+   util_Assert ((s < u) || (v < r),+      "MiniProc1:   Overlap of E1 and E2 dans MiniProc");+#endif++   if (s < r || v < u)+      return;+   inf = u;+   /* sup = v; */++#ifdef DEBUG+   for (i = r; i < s; i++)+      util_Assert (T[i][c] <= T[i + 1][c], "Wrong order in MiniProc1");+   for (i = u; i < v; i++)+      util_Assert (T[i][c] <= T[i + 1][c], "Wrong order in MiniProc1");+#endif+++   for (i = r; i <= s; i++) {+      low = T[i][c] - work->dlim;+      high = low + 2.0 * work->dlim;+      /* consider only points at distance <= dlim of T[i] w.r. to coord. c */+      while (inf <= v && T[inf][c] <= low)+         ++inf;+      j = inf;+      while (j <= v && T[j][c] < high) {+         res->Distance (res, T[i], T[j]);+         ++j;+      }+      if (work->Torus) {          /* AND (np <= kk): does not work with this +                                     cond. */++         /* Search for close points in the torus */+         low += 1.0;+         high -= 1.0;+         k = u;+         l = v;+         while (k <= v && T[k][c] < high) {+            res->Distance (res, T[i], T[k]);+            ++k;+         }+         while (l >= u && T[l][c] > low) {+            res->Distance (res, T[i], T[l]);+            --l;+         }+      }+   }+}+++/*=========================================================================*/++void snpair_CheckBoundary (snpair_Res * res, long r, long s, long u, long v,+   int nr, int nrb, int np, int c)+/*+ * Compute the minimal distance between the points of the sets E1 = A[r..s]+ * and E2 = A[u..v].+ * nrb is the recursion level of the calls of snpair_CheckBoundary.+ * A always stands for Points[np], sorted with respect to coordinate c.+ */+{+   long jmed2, imed2;+   long jmed, imed;+   long nextc;+   lebool newc;+   snpair_PointTableType B, A;+   WorkType *work = res->work;++#ifdef DEBUG+   printf ("CheckBoundary:   ");+   printf (" %8ld %8ld %8ld %8ld %3d %3d %3d %3d\n",+      r, s, u, v, nr, nrb, np, c);+#endif++   if (r > s || u > v)+      return;++   util_Assert (np <= work->Maxnp, "np > Maxnp in snpair_CheckBoundary");+   A = res->Points[np];+   newc = ((nrb - 1) % work->L2) == 0;+   if (newc && np < work->Maxnp) {+      B = res->Points[np + 1];+      ++np;+      if (c < work->kk)+         nextc = c + 1;+      else+         nextc = 1;++      /* Copy the remaining points in the table of level np+1, then */+      /* sort with respect to coordinate nextc. */+      CopyPoints (A, B, r, s);+      CopyPoints (A, B, u, v);+      snpair_QuickSort (B, r, s, nextc);+      snpair_QuickSort (B, u, v, nextc);++   } else {+      nextc = c;+      B = A;+   }++   if ((nrb >= work->kk || s - r < snpair_env.Seuil2)+      || v - u < snpair_env.Seuil2) {+      /* Max recursion or small sets of points */+      res->MiniProc (res, B, r, s, u, v, np, nextc);+      return;+   }++   /* We halve each set of points, and we check each half on one side */+   /* with each half of the other side. */+   imed = (r + s) / 2;+   jmed = (u + v) / 2;++   /* Check the halves which are face to face */+   snpair_CheckBoundary (res, r, imed, u, jmed, nr + 1, nrb + 1, np, nextc);+   snpair_CheckBoundary (res, imed + 1, s, jmed + 1, v, nr + 1, nrb + 1, np,+                         nextc);++   /* Check the other (crossed) halves */+   if ((work->Torus && np <= work->kk) && newc) {+      imed2 = imed;+      jmed2 = jmed + 1;+      dlimSlice (res, B, &r, &imed2, &jmed2, &v, nextc, TRUE);+      snpair_CheckBoundary (res, r, imed2, jmed2, v, nr + 1, nrb + 1, np,+         nextc);++      imed2 = imed + 1;+      jmed2 = jmed;+      dlimSlice (res, B, &u, &jmed2, &imed2, &s, nextc, TRUE);+      snpair_CheckBoundary (res, u, jmed2, imed2, s, nr + 1, nrb + 1, np,+         nextc);+   }++   jmed2 = jmed + 1;+   imed2 = imed + 1;+   if (newc)+      dlimSlice (res, B, &r, &imed, &jmed2, &v, nextc, FALSE);+   snpair_CheckBoundary (res, r, imed, jmed + 1, v, nr + 1, nrb + 1, np,+      nextc);+   if (newc)+      dlimSlice (res, B, &u, &jmed, &imed2, &s, nextc, FALSE);+   snpair_CheckBoundary (res, u, jmed, imed + 1, s, nr + 1, nrb + 1, np,+      nextc);+}+++/*=========================================================================*/++static void Setdlim (snpair_Res *res, snpair_PointType A[], long r, long s)+/* + * Used in snpair_BickelBreiman to update dlim+ */+{+   long i;+   WorkType *work = res->work;++   work->dlimp = 0.0;+   for (i = r; i <= s; i++) {+      if (A[i][0] > work->dlimp)+         work->dlimp = A[i][0];+   }+   if (work->pp == 0 || work->pp == 1)+      work->dlim = work->dlimp;+   else if (work->pp == 2)+      work->dlim = sqrt (work->dlimp);+   else+      work->dlim = pow (work->dlimp, work->Invp);++#ifdef DEBUG+   printf ("Setdlim: ");+   num_WriteD (work->dlim, 10, 5, 1);+   printf ("\n");+#endif+}+++/*=========================================================================*/++void snpair_FindClosePairs (snpair_Res * res, long r, long s,+   int nr, int np, int c)+/*+ * Checks whether the minimal distance between the 2 nearest points,+ * amongst those with indices [r..s] in the table of level np, is < dlim.  + * If so, updates dlim and dlimp. A and B are always Points [np] and+ * Points [np+1].                   + * Assume that A = Point [np] is sorted with respect to coordinate c.    + */+{+   long jmed2;+   long imed2;+   long imed;+   long nextc;                    /* Next coordinate to be used */+   snpair_PointTableType B;+   snpair_PointTableType A;+   WorkType *work = res->work;++   /* IF (((nr-1) MOD L) = 0) THEN newc := TRUE ELSE newc := FALSE END; */+#ifdef DEBUG+   printf ("FindClosePairs:   ");+   printf (" %8ld %8ld %3d %3d %3d\n", r, s, nr, np, c);+#endif++   util_Assert (np <= work->Maxnp, "np > Maxnp in snpair_FindClosePairs");+   A = res->Points[np];+   if (s - r < snpair_env.Seuil1) {+      res->VerifPairs (res, A, r, s, np, c);+      /* Here we are finished */+      return;+   }++   /* We divide the points in 2 approximately equal sets E1 and E2; */+   /* then recursions upon the sets E1 and E2. */+   imed = (r + s) / 2;+   if (nr % work->L1 == 0 && np < work->Maxnp && np < work->kk) {+      /****** Condition np < kk is temporary... ********/+      util_Assert (np == 1 + (nr - 1) / work->L1,+         "Bad np in snpair_FindClosePairs");+      /* IF np >= Maxnp THEN VerifPairs (A^, r, s, nr, c); RETURN END; */++      /* We shall now increase np and switch coordinate.  */+      /* Copy the points in a new table for the next level. */+      B = res->Points[np + 1];+      CopyPoints (A, B, r, s);+      if (c < work->kk)+         nextc = c + 1;+      else+         nextc = 1;+      util_Assert (nextc == 1 + (np % work->kk),+         "Bad nextc dans snpair_FindClosePairs");+      snpair_QuickSort (B, r, imed, nextc);+      snpair_QuickSort (B, imed + 1, s, nextc);+      snpair_FindClosePairs (res, r, imed, nr + 1, np + 1, nextc);+      snpair_FindClosePairs (res, imed + 1, s, nr + 1, np + 1, nextc);++   } else {+      snpair_FindClosePairs (res, r, imed, nr + 1, np, c);+      snpair_FindClosePairs (res, imed + 1, s, nr + 1, np, c);+   }++   /* It remains to check the boundary between E1 and E2. */+   if (work->kk == 1) {+      res->Distance (res, A[imed], A[imed + 1]);+      if (work->Torus)+         res->Distance (res, A[r], A[s]);+      return;+   }++   /* Bring m and n closer in order to sqeeze only the points which could */+   /* be at a distance less than dlim from the median. */+   if (work->BBFlag)+      Setdlim (res, A, r, s);+   if (work->Torus && np <= work->kk && (nr - 1) % work->L1 == 0) {+      imed2 = imed;+      jmed2 = imed + 1;+      dlimSlice (res, A, &r, &imed2, &jmed2, &s, c, TRUE);+      snpair_CheckBoundary (res, r, imed2, jmed2, s, nr, 1, np, c);+   }++   jmed2 = imed + 1;+   dlimSlice (res, A, &r, &imed, &jmed2, &s, c, FALSE);+   snpair_CheckBoundary (res, r, imed, jmed2, s, nr, 1, np, c);+}+++/*=========================================================================*/++#if 0+#define Epsilon 1.0e-10++static double Probsup (double b, double c, double x)+{+   int jsup;+   int msup;+   int m;+   int j;+   double comb;+   double mLR;+   double jLR;+   double mFact;+   double Sum2;+   double Sum;+   double Previous;++   if (x < 0.0)+      return 0.0;++   Sum = 0.0;+   mFact = 1.0;+   if (x <= 0.0) {+      msup = c * b;+      if (msup > 100) {+         msup = 100;+         util_Warning (TRUE, "Probsup: msup > 100. Reset to 100");+      }+      for (m = 1; m <= msup; m++) {+         mLR = m;+         mFact *= mLR;+         Sum += (pow (b, mLR) / mFact) * (1.0 - mLR / (c * b));+      }+      if (msup >= 0)+         Sum += 1.0;+      return Sum * exp (-b);+   }++   Previous = -1.0;+   m = 1;+   msup = c * b + x;+   if (msup > 100) {+      msup = 100;+      util_Warning (TRUE, "Probsup: msup > 100.  Reset to 100");+   }+   while (m <= msup && Sum - Previous > Epsilon) {+      Previous = Sum;+      Sum2 = 0.0;+      mLR = m;+      mFact *= mLR;+      jsup = x;+      if (jsup > m) {+         jsup = m;+         util_Warning (TRUE, "Probsup: jsup > m.  Reset to m");+      }+      comb = 1.0;+      for (j = 0; j <= jsup; j++) {+         jLR = j;+         Sum2 += comb * pow (jLR - x, jLR) *+            pow (c * b + x - jLR, mLR - jLR - 1.0);+         comb *= (mLR - jLR) / (jLR + 1.0);+      }+      Sum += (c * b + x - mLR) / (mFact * pow (c, mLR)) * Sum2;+      ++m;+   }+   if (msup >= 0)+      Sum += 1.0;+   return Sum * exp (-b);+}+++/*=========================================================================*/++static double Probinf (double b, double c, double x)+{+   int msup;+   int m;+   double mLR;+   double mFact;+   double Sum;++   if (x >= 0.0)+      return 1.0;++   msup = c * b + x;+   if (msup > 100) {+      msup = 100;+      util_Warning (TRUE, "Probinf: msup > 100. Reset to 100");+   }+   Sum = 0.0;+   mFact = 1.0;+   for (m = 1; m <= msup; m++) {+      mLR = m;+      mFact *= mLR;+      Sum += exp (-(mLR - x) / c) *+         (pow (mLR - x, mLR - 1.0) / (pow (c, mLR) * mFact));+   }+   if (msup >= 0)+      Sum = -(x * Sum) + exp (x / c);+   return Sum;+}+++/*=========================================================================*/++static double FDistGPlus (double Bidon, double c)+/*+ * Obsolete. This discontinuous distribution uses a complicated statistic+ * and did not seem sensitive. We don't use it anymore.++ *  See the reference+ *  P. L'Ecuyer, J.-F. Cordeau, and R. Simard,  "Close-Point Spatial Tests+ *     and their Application to Random Number Generators",+ *     Operations Research, 48, 2 (2000), 308--317+ *+ */+{+   int lSup;+   int l;+   double lLR;+   double lFact;+   double Previous;+   double Sum;++   if ((!GPlusFlag || GPlust0 != t0) || GPlust1 != t1) {+      GPlust0 = t0;+      GPlust1 = t1;+      GPlusFlag = TRUE;+      /* +         fdist_FindJumps (W, Detail);++      FindJumpsKnown (Bidon, FDistGPlus, GPlust0, 20.0, 0.00001, &GPlusNJump,+      &GPlusJumpX, &GPlusJumpYBottom, &GPlusJumpYTop);*/+   }++   if (c < 0.0)+      return 0.0;+   l = 1;+   Sum = 0.0;+   Previous = -1.0;+   lFact = 1.0;+   lSup = GPlust0 * c;+   while (l <= lSup && Sum - Previous > Epsilon) {+      Previous = Sum;+      lLR = l;+      lFact *= lLR;+      Sum += pow (GPlust0, lLR) / lFact *+                Probsup (GPlust1 - GPlust0, c, GPlust0 * c - lLR);+      ++l;+   }+   Sum += Probsup (GPlust1 - GPlust0, c, GPlust0 * c);+   return Sum * exp (-GPlust0);+}+++/*=========================================================================*/++static double FDistGMinus (double Bidon, double c)+/*+ * Obsolete. This discontinuous distribution uses a complicated statistic+ * and did not seem sensitive. We don't use it anymore.++ *  See the reference+ *  P. L'Ecuyer, J.-F. Cordeau, and R. Simard,  "Close-Point Spatial Tests+ *     and their Application to Random Number Generators",+ *     Operations Research, 48, 2 (2000), 308--317+ *+ */+{+   int l;+   double lLR;+   double lFact;+   double Previous;+   double Sum;++   if ((!GMinusFlag || GMinust0 != t0) || GMinust1 != t1) {+      GMinust0 = t0;+      GMinust1 = t1;+      GMinusFlag = TRUE;+      /*+      FindJumpsKnown (Bidon, FDistGMinus, GMinust1, 20.0, 0.00001,+         &GMinusNJump, &GMinusJumpX, &GMinusJumpYBottom, &GMinusJumpYTop);+      */+   }++   if (c < 0.0)+      return 0.0;+   l = 1;+   Sum = 0.0;+   Previous = -1.0;+   lFact = 1.0;+   while (Sum - Previous > Epsilon) {+      Previous = Sum;+      lLR = l;+      lFact *= lLR;+      Sum += pow (GMinust0, lLR) / lFact *+             Probinf (GMinust1 - GMinust0, c, GMinust0 * c - lLR);+      ++l;+   }+   Sum += Probinf (GMinust1 - GMinust0, c, GMinust0 * c);+   return Sum * exp (-GMinust0);+}+++/*=========================================================================*/++static double FDistHPlus (double b, double x)+/*+ * Obsolete. This discontinuous distribution uses a complicated statistic+ * and did not seem sensitive. We don't use it anymore.++ *  See the reference+ *  P. L'Ecuyer, J.-F. Cordeau, and R. Simard,  "Close-Point Spatial Tests+ *     and their Application to Random Number Generators",+ *     Operations Research, 48, 2 (2000), 308--317+ *+ */+{+   int msup;+   int jsup;+   int m;+   int j;+   double comb;+   double mLR;+   double jLR;+   double mFact;+   double Sum2;+   double Sum;+   double Previous;++   if ((!HPlusFlag || HPlust0 != t0) || HPlust1 != t1) {+      /* this function has a single jump at x = 0 */+      HPlust0 = t0;+      HPlust1 = t1;+      HPlusFlag = TRUE;/*+      FindJumpsKnown (b, FDistHPlus, 1.0, 0.00001, 1.E-6, &HPlusNJump,+      &HPlusJumpX, &HPlusJumpYBottom, &HPlusJumpYTop);*/+   }++   if (x < 0.0)+      return 0.0;++   Sum = 0.0;+   mFact = 1.0;+   if (x <= 0.0) {+      msup = b;+      if (msup > 100)+         msup = 100;+      for (m = 1; m <= msup; m++) {+         mLR = m;+         mFact *= mLR;+         Sum += pow (b, mLR) / mFact * (1.0 - mLR / b);+      }+      if (msup >= 0)+         Sum += 1.0;+      return Sum * exp (-b);+   }++   Previous = -1.0;+   m = 1;+   msup = b + x;+   if (msup > 100)+      msup = 100;+   while (m <= msup && Sum - Previous > Epsilon) {+      Previous = Sum;+      Sum2 = 0.0;+      mLR = m;+      mFact *= mLR;+      jsup = x;+      if (jsup > m)+         jsup = m;+      comb = 1.0;+      for (j = 0; j <= jsup; j++) {+	 jLR = j;+	 Sum2 += comb*pow (jLR - x, jLR)*pow (b + x - jLR, mLR - jLR - 1.0);+	 comb *= (mLR - jLR) / (jLR + 1.0);+      }+      Sum += (b + x - mLR) / mFact * Sum2;+      ++m;+   }+   if (msup >= 0)+      Sum += 1.0;+   return Sum * exp (-b);+}+++/*=========================================================================*/++static double FDistHMinus (double b, double x)+/*+ * Obsolete. This discontinuous distribution uses a complicated statistic+ * and did not seem sensitive. We don't use it anymore.++ *  See the reference+ *  P. L'Ecuyer, J.-F. Cordeau, and R. Simard,  "Close-Point Spatial Tests+ *     and their Application to Random Number Generators",+ *     Operations Research, 48, 2 (2000), 308--317+ *+ */+{+   int msup;+   int m;+   double mLR;+   double mFact;+   double Sum;++   if ((!HMinusFlag || HMinust0 != t0) || HMinust1 != t1) {+      HMinust0 = t0;+      HMinust1 = t1;+      HMinusFlag = TRUE;+      /*+      FindJumpsKnown (b, FDistHMinus, -b, 0.0001, 0.00001, &HMinusNJump,+      &HMinusJumpX, &HMinusJumpYBottom, &HMinusJumpYTop); */+   }++   if (x >= 0.0)+      return 1.0;++   msup = b + x;+   if (msup > 100)+      msup = 100;+   Sum = 0.0;+   mFact = 1.0;+   for (m = 1; m <= msup; m++) {+      mLR = m;+      mFact *= mLR;+      Sum += exp (-(mLR - x)) * (pow (mLR - x, mLR - 1.0) / mFact);+   }++   if (msup >= 0)+      Sum = -(x * Sum) + exp (x);+   return Sum;+}++#endif++/*=========================================================================*/++static void snpair_AllocPoints (snpair_Res *res, long n)+{+   long i;+   WorkType *work = res->work;++   if (n <= 0)+      return;+   /* Allocates Maxnp tables of pointers to the points; one for each level+      of recursion */+   for (i = 1; i <= work->Maxnp; i++)+      res->Points[i] =+         util_Calloc ((size_t) (n + 1), sizeof (snpair_PointType));++   /* Allocates memory for the points; initially, only the first table+      of pointers, i = 1, points to the points. */+   for (i = 0; i <= n; i++)+      res->Points[1][i] = util_Calloc ((size_t) (work->kk + 1),+                                       sizeof (double));++   res->CloseDist = util_Calloc ((size_t) work->mcd + 1, sizeof (double));+}+++/*=========================================================================*/++static void snpair_DeletePoints (snpair_Res * res)+/*+ * To clean up after the test.+ */+{+   long i;+   long n = res->n;+   WorkType *work = res->work;++   if (n <= 0)+      return;+   res->CloseDist = util_Free (res->CloseDist);++   for (i = 0; i <= n; i++)+      util_Free (res->Points[1][i]);++   for (i = 1; i <= work->Maxnp; i++)+      res->Points[i] = util_Free (res->Points[i]);+}+++/*=========================================================================*/++static void AllocClosePairs (+   snpair_Res *res,           /* Results holder */+   long N,+   long n,+   int m+   )+{+   snpair_AllocPoints (res, n);+   res->Yn = statcoll_Create (m, "Yn: The m jumps of Y");+   res->Y = statcoll_Create (N * m + 100,+      "Y: All the jumps of Y, superposed");+   res->U = statcoll_Create (N * m,+      "U: The jumps of Y transformed into uniforms");+   res->V = statcoll_Create (N * m + 100, "V: A copy of the uniforms");+   res->S = statcoll_Create (N * m + 100, "S: Spacings");+   res->TheWn = statcoll_Create (N, "The N values of the W_n");+   res->TheWni = statcoll_Create (N * m, "The Nm values of the W_{n,i}");+   res->ThepValAD = statcoll_Create (N, "The p-values of A2");+   res->BitMax = statcoll_Create (N, "Largest bit distances");+}+++/*=========================================================================*/++static void CleanClosePairs (snpair_Res * res)+{+   int i;+   res->Yn = statcoll_Delete (res->Yn);+   res->Y = statcoll_Delete (res->Y);+   res->U = statcoll_Delete (res->U);+   res->V = statcoll_Delete (res->V);+   res->S = statcoll_Delete (res->S);+   res->TheWn = statcoll_Delete (res->TheWn);+   res->TheWni = statcoll_Delete (res->TheWni);+   res->ThepValAD = statcoll_Delete (res->ThepValAD);+   res->BitMax = statcoll_Delete (res->BitMax);+   snpair_DeletePoints (res);+   for (i = 0; i < snpair_StatType_N; i++) {+      res->sVal[i] = -1.0;+      res->pVal[i] = -1.0;+   }+}+++/*=========================================================================*/++static void InitRes (+   snpair_Res *res,           /* Results holder */+   long N,                    /* Number of replications */+   long n,                    /* Number of points */+   int m                      /* Number of closest distances kept */+   )+/* + * Initializes the res structure+ */+{+   if (res->CleanFlag)+      CleanClosePairs (res);+   AllocClosePairs (res, N, n, m);+   res->n = n;+   res->CleanFlag = TRUE;+}+++/*-------------------------------------------------------------------------*/++snpair_Res *snpair_CreateRes (void)+{+   snpair_Res *res;+   res = util_Malloc (sizeof (snpair_Res));+   memset (res, 0, sizeof (snpair_Res));+   res->work = util_Malloc (sizeof (WorkType));+   res->CleanFlag = FALSE;+   return res;+}+++/*-------------------------------------------------------------------------*/++void snpair_DeleteRes (snpair_Res * res)+{+   if (res == NULL)+      return;+   if (res->CleanFlag)+      CleanClosePairs (res);+   res->work = util_Free (res->work);+   util_Free (res);+}+++/*=========================================================================*/++static void WriteSeuils (WorkType * work, lebool flag, double mu2,+   double nLR, double kLR)+{+   printf ("\n   Seuil1 = %2d\n   Seuil2 = %2d\n   "+      "Seuil3 = %2d\n   Seuil4 = %2d\n"+      "   L1 = %2d\n   L2 = %2d\n   s1 = ", snpair_env.Seuil1,+      snpair_env.Seuil2, snpair_env.Seuil3, snpair_env.Seuil4, work->L1,+      work->L2);++   /* s1 = n / 2^{kL1} */+   num_WriteD (nLR * pow (2.0, -kLR * work->L1), 9, 2, 2);+   printf ("\n   s2 = ");+   /* s2 = n / 2^{kL2} */+   num_WriteD (nLR * pow (2.0, -kLR * work->L2), 9, 2, 2);+   printf ("\n\n");++   if (flag) {+      printf ("   The minimal distance, to the power k, should be"+         " approximately\n      exponential with mean mu2 = ");+      num_WriteD (mu2, 12, 4, 2);+      printf ("\n\n   dlim1  = ");+      num_WriteD (work->dlim1, 15, 5, 3);+      printf ("\n   dlim1p = ");+      num_WriteD (work->dlim1p, 15, 5, 3);+      printf ("\n\n");+   }+}+++/*=========================================================================*/++static void CalcSeuils (WorkType * work, long k, long m, lebool flag,+   double mu2, double nLR, double kLR)+{+   work->L1 = 1 + num_Log2 (nLR / snpair_env.Seuil3) / k;+   work->L2 = 1 + num_Log2 (nLR / snpair_env.Seuil4) / k;+   if (work->L1 < 1)+      work->L1 = 1;+   if (work->L2 < 1)+      work->L2 = 1;+   if (k < 6 && work->L1 < 2)+      work->L1 = 2;+   if (k < 6 && work->L2 < 2)+      work->L2 = 2;+   work->dlim1 = pow (m * mu2, 1.0 / k);+   work->dlim1p = pow (work->dlim1, work->pLR);+   if (swrite_Parameters)+      WriteSeuils (work, flag, mu2, nLR, kLR);+}+++/*=========================================================================*/++void snpair_WriteDataCP (unif01_Gen * gen, char *TestName,+   long N, long n, int r, int t, int p, int m, lebool Torus)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",  t = %1d,", t);+   if (p >= 0)+      printf ("  p = %1d,", p);+   printf ("  m = %1d,  Torus = ", m);+   util_WriteBool (Torus, 5);+   printf ("\n\n");+}+++/*=========================================================================*/+#define SPACINGS_9+/* + * La constante SPACINGS permet l'inclusion des 4 tests de ClosePairs suivants+ * qui sont mis en commentaire sinon: NP-S, NP-PR, mNP1-S, mNP2-S.+ */++void snpair_WriteResultsCP (unif01_Gen * gen, chrono_Chrono * Timer,+   snpair_Res * res, long N, long m)+{+   printf ("\n---------------------------------------\n");+   printf ("Test based on the 2 nearest points (NP):\n\n");++   if (N == 1) {+      printf ("The closest distance                  : ");+      num_WriteD (res->CloseDist[1], 7, 2, 2);+      printf ("\n");+      gofw_Writep1 (res->pVal[snpair_NP]);+   } else {+      printf ("Stat. AD on the N values (NP)         :");+      gofw_Writep2 (res->sVal[snpair_NP], res->pVal[snpair_NP]);+#ifdef SPACINGS+      printf ("Stat. AD after spacings (NP-S)        :");+      gofw_Writep2 (res->sVal[snpair_NPS], res->pVal[snpair_NPS]);+      printf ("Stat. AD after power ratio (NP-PR)    :");+      gofw_Writep2 (res->sVal[snpair_NPPR], res->pVal[snpair_NPPR]);+#endif+   }++   if (m > 1) {+      printf ("\nA2 test based on the spacings between the\n"+              "   successive jump times of process Y_n(t):\n\n");+      printf ("A2 test on the values of A2 (m-NP)    :");+      gofw_Writep2 (res->sVal[snpair_mNP], res->pVal[snpair_mNP]);++      if (N > 1) {+         printf ("Test on the Nm values of W_{n,i}(mNP1):");+         gofw_Writep2 (res->sVal[snpair_mNP1], res->pVal[snpair_mNP1]);+#ifdef SPACINGS+         printf ("Stat. AD after spacings (mNP1-S)      :");+         gofw_Writep2 (res->sVal[snpair_mNP1S], res->pVal[snpair_mNP1S]);+#endif+         printf ("Test on the jump times of Y\n   (superposition of Yn):\n\n");+         printf ("Expected number of jumps of Y = mN    : %7ld\n", m*N);+         printf ("Number of jumps of Y                  ");+         if (res->sVal[snpair_NJumps] >= N*NUM_JUMPS_LIM)+            printf ("> %6.0f     *****\n", res->sVal[snpair_NJumps]);+         else+            printf (": %7.0f\n", res->sVal[snpair_NJumps]);+         gofw_Writep1 (res->pVal[snpair_NJumps]);++         if (res->Y->NObs > 0) {+            printf ("Stat. AD (mNP2)                       :");+            gofw_Writep2 (res->sVal[snpair_mNP2], res->pVal[snpair_mNP2]);+#if 1+            if (snpair_mNP2S_Flag) {+               printf ("Stat. AD after spacings (mNP2-S)      :");+               gofw_Writep2 (res->sVal[snpair_mNP2S], res->pVal[snpair_mNP2S]);+            }+#endif+         }+      }+   }+   swrite_Final (gen, Timer);+}+++/*=========================================================================*/++void snpair_ClosePairs (unif01_Gen * gen, snpair_Res * res,+   long N, long n, int r, int k, int p, int m)+/*+ * Looks at the m closest pairs in the torus and the first m jumps of the+ * process Y_n(t). A simplified version of snpair_ClosePairs.  + */+{+   long j;+   long i;+   long Seq;+   double Wn;+   double t1;+   snpair_PointType T;+   double x;+   double NextJump;+   double Jump;+   double mu2;                    /* Expected minimum distance */+   double A2;+   double Vol;                    /* Volume of unit sphere in k dimension */+   double mLR, nLR, kLR;+   fmass_INFO Mass;+   double pLeft, pRight;+   statcoll_Collector *Q;+   WorkType *work;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "snpair_ClosePairs test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      snpair_WriteDataCP (gen, TestName, N, n, r, k, p, m, TRUE);++   /* util_Assert (k <= snpair_MaxDim, "snpair_ClosePairs: k >+      snpair_MaxDim");+   util_Assert (n <= snpair_MaxNumPoints,+      "snpair_ClosePairs:   n > snpair_MaxNumPoints"); */+   util_Assert (m > 0, "snpair_ClosePairs:   m <= 0");+   util_Assert (m <= snpair_MAXM, "snpair_ClosePairs:   m > snpair_MAXM");+   if (res == NULL) {+      localRes = TRUE;+      res = snpair_CreateRes ();+   }+   work = res->work;+   work->Torus = TRUE;+   work->kk = k;+   work->pp = p;+   work->mm = m;+   kLR = k;+   nLR = n;+   mLR = m;+   work->mcd = 2 * m;+   if (p == 0)+      work->pLR = 1.0;+   else+      work->pLR = p;+   work->Invp = 1.0 / work->pLR;+   if (k < snpair_MAXREC)+      work->Maxnp = k;+   else+      work->Maxnp = snpair_MAXREC;+   work->BBFlag = FALSE;           /* Bickel-Breiman Flag */++   Vol = num2_VolumeSphere ((double) p, k);+   mu2 = 2.0 / (nLR * (nLR - 1.0) * Vol);+   t1 = mLR;++   CalcSeuils (work, k, m, TRUE, mu2, nLR, kLR);+   InitRes (res, N, n, m);+   res->Distance = snpair_DistanceCP;+   res->VerifPairs = snpair_VerifPairs1;+   res->MiniProc = snpair_MiniProc1;++   /* Beginning of test */+   for (Seq = 1; Seq <= N; Seq++) {++      for (i = 1; i <= n; i++) {+         /* Generate n points in dimension k */+         T = res->Points[1][i];+         for (j = 1; j <= k; j++)+            T[j] = unif01_StripD (gen, r);+      }+      res->NumClose = 0;+      work->dlimp = work->dlim = kLR; /* Initial upper bounds */+      snpair_QuickSort (res->Points[1], 1, n, 1);+      snpair_FindClosePairs (res, 1, n, 1, 1, 1);+      Wn = 1.0 - exp (-pow (res->CloseDist[1], kLR) / mu2);+      statcoll_AddObs (res->TheWn, Wn);+      statcoll_Init (res->Yn, m);+      statcoll_Init (res->U, m);+      if (m > 1) {+         /* Calculate the spacings Delta_{n,i} between the jumps of Y_n, */+         /* then the W^*_{n(i)}, which are in principle i.i.d. U(0,1).  */+         Jump = 0.0;+         for (i = 1; i <= m; i++) {+            NextJump = pow (res->CloseDist[i], kLR) / mu2;+            statcoll_AddObs (res->Yn, NextJump);+            x = 1.0 - exp (-(NextJump - Jump));+            statcoll_AddObs (res->U, x);+            statcoll_AddObs (res->TheWni, x);+            Jump = NextJump;+         }++         tables_QuickSortD (res->U->V, 1, m);+         /* res->U should now contain m random var. i.i.d U(0,1), sorted */+         if (swrite_Collectors) {+            statcoll_Write (res->Yn, 5, 14, 4, 3);+            statcoll_Write (res->U, 5, 14, 4, 3);+         }+         A2 = gofs_AndersonDarling (res->U->V, m);+         x = fbar_AndersonDarling (m, A2);+         statcoll_AddObs (res->ThepValAD, x);++         if (N > 1) {+            /* Put in res->Y all the jumps between 0 and t1 */+            for (i = 1; i <= res->NumClose; i++) {+               NextJump = pow (res->CloseDist[i], kLR) / mu2;+               if (NextJump <= t1)+                  statcoll_AddObs (res->Y, NextJump);+            }+         }+      }+   }++   if (N == 1)+      res->pVal[snpair_NP] = 1.0 - Wn;+   else {+      Q = res->TheWn;+      tables_QuickSortD (Q->V, 1, N);+      /* Test NP at level 1 */+      res->sVal[snpair_NP] = gofs_AndersonDarling (Q->V, N);+      res->pVal[snpair_NP] = fbar_AndersonDarling (N, res->sVal[snpair_NP]);++#ifdef SPACINGS+      /* Test NP with the spacings */+      tables_CopyTabD (Q->V, res->V->V, 1, N);+      gofs_DiffD (res->V->V, res->S->V, 1, N, 0.0, 1.0);+      gofs_IterateSpacings (res->V->V, res->S->V, N);+      tables_QuickSortD (res->V->V, 1, N);+      res->sVal[snpair_NPS] = gofs_AndersonDarling (res->V->V, N);+      res->pVal[snpair_NPS] =+         fbar_AndersonDarling (N, res->sVal[snpair_NPS]);+      /* Test NP with power ratio */+      tables_CopyTabD (Q->V, res->V->V, 1, N);+      gofs_PowerRatios (res->V->V, N);+      tables_QuickSortD (res->V->V, 1, N);+      res->sVal[snpair_NPPR] = gofs_AndersonDarling (res->V->V, N);+      res->pVal[snpair_NPPR] =+         fbar_AndersonDarling (N, res->sVal[snpair_NPPR]);+#endif+   }++   if (m > 1) {+      if (N == 1) {+         res->sVal[snpair_mNP] = A2;+         res->pVal[snpair_mNP] = res->ThepValAD->V[1];+      } else {+         tables_CopyTabD (res->ThepValAD->V, res->V->V, 1, N);+         tables_QuickSortD (res->V->V, 1, N);+         res->sVal[snpair_mNP] = gofs_AndersonDarling (res->V->V, N);+         res->pVal[snpair_mNP] =+            fbar_AndersonDarling (N, res->sVal[snpair_mNP]);+         Q = res->TheWni;+         tables_QuickSortD (Q->V, 1, Q->NObs);+         /* Here, Q->NObs = N*m */+         res->sVal[snpair_mNP1] = gofs_AndersonDarling (Q->V, Q->NObs);+         res->pVal[snpair_mNP1] =+            fbar_AndersonDarling (Q->NObs, res->sVal[snpair_mNP1]);+#ifdef SPACINGS+         /* Test NP with the spacings */+         tables_CopyTabD (Q->V, res->V->V, 1, Q->NObs);+         gofs_DiffD (res->V->V, res->S->V, 1, Q->NObs, 0.0, 1.0);+         gofs_IterateSpacings (res->V->V, res->S->V, Q->NObs);+         tables_QuickSortD (res->V->V, 1, Q->NObs);+         res->sVal[snpair_mNP1S] = gofs_AndersonDarling (res->V->V, Q->NObs);+         res->pVal[snpair_mNP1S] =+            fbar_AndersonDarling (Q->NObs, res->sVal[snpair_mNP1S]);+#endif+         /* Superposition process of all the jumps of Y_n in [0, t1].+            Conditionnally on TotJumps = res->Y^.NObs, these jumps should be +            uniformly distributed in [0, t1]. */++         Q = res->Y;+         for (i = 1; i <= Q->NObs; i++)+            Q->V[i] /= t1;+         if (Q->NObs > 0) {+            tables_QuickSortD (Q->V, 1, Q->NObs);+            /* res->Y must now contain random var. i.i.d U(0,1), sorted */+            res->sVal[snpair_mNP2] = gofs_AndersonDarling (Q->V, Q->NObs);+            res->pVal[snpair_mNP2] =+               fbar_AndersonDarling (Q->NObs, res->sVal[snpair_mNP2]);+	 }++         Mass = fmass_CreatePoisson (N * m);+         pLeft = fdist_Poisson2 (Mass, res->Y->NObs);+         pRight = fbar_Poisson2 (Mass, res->Y->NObs);+         fmass_DeletePoisson (Mass);+         res->sVal[snpair_NJumps] = res->Y->NObs;+         res->pVal[snpair_NJumps] = gofw_pDisc (pLeft, pRight);++#if 1+         /* Test on res->Y with the spacings */+         statcoll_Init (res->V, Q->Dim);+         statcoll_Init (res->S, Q->Dim);+         tables_CopyTabD (Q->V, res->V->V, 1, Q->NObs);+         gofs_DiffD (res->V->V, res->S->V, 1, Q->NObs, 0.0, 1.0);+         gofs_IterateSpacings (res->V->V, res->S->V, Q->NObs);+         tables_QuickSortD (res->V->V, 1, Q->NObs);+         res->sVal[snpair_mNP2S] = gofs_AndersonDarling (res->V->V, Q->NObs);+         res->pVal[snpair_mNP2S] =+            fbar_AndersonDarling (Q->NObs, res->sVal[snpair_mNP2S]);+#endif+      }+   }++   if (swrite_Collectors) {+      if (N > 1)+         statcoll_Write (res->Y, 5, 14, 4, 3);+      statcoll_Write (res->TheWn, 5, 14, 4, 3);+      statcoll_Write (res->TheWni, 5, 14, 4, 3);+      statcoll_Write (res->ThepValAD, 5, 14, 4, 3);+   }++   if (swrite_Basic)+      snpair_WriteResultsCP (gen, Timer, res, N, m);+   if (localRes)+      snpair_DeleteRes (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/+#if 0++void snpair_ReTestY (long N, long n, int m, double tt0, double tt1)+/*+ * Make more (experimental) tests on Y after a call to ClosePairs1+ * (To do?? We should renormalize the Y[i] by multiplying them by nM)++ *****************************************+  This procedure is not used anymore. It makes use of discontinuous+  distribution functions and the associated statistics are very+  complicated and did not seem sensitive.+  ****************************************+ */+{+   long i;+   double Bidon;+   double x;+   double iLR;+   double Fact;+   double HM;+   double HP;+   double GM;+   double GP;+   statcoll_Collector *Q = res->Y;+   fdist_FUNC_JUMPS *GPJumps;     /* All info on the jumps of G+ */+   fdist_FUNC_JUMPS *GMJumps;     /* All info on the jumps of G- */+   fdist_FUNC_JUMPS *HPJumps;     /* All info on the jumps of H+ */+   fdist_FUNC_JUMPS *HMJumps;     /* All info on the jumps of H- */++   /* Calculate statistics G+, G-, H+, H- */+   util_Assert (!swrite_AutoClean,+                "snpair_ReTestY:   swrite_AutoClean must be FALSE");+   util_Assert (res->Y != NULL,+                "snpair_ReTestY:   res->Y is a NULL pointer");++   Fact = N * m;+   for (i = 1; i <= Q->NObs; i++)+      Q->V[i] *= Fact;+   HP = 0.0;+   HM = 0.0;+   i = 1;+   while (Q->V[i] <= tt0 && i <= Q->NObs)+      ++i;+   GP = (i - 1) / tt0;+   while (Q->V[i] <= tt1 && i <= Q->NObs)+      ++i;+   GM = (i - 1) / tt1;+   if (i - 1 - tt1 < 0.0)+      HM = i - 1 - tt1;++   for (i = 1; i <= Q->NObs; i++) {+      if (Q->V[i] <= tt1) {+         x = Q->V[i];+         iLR = i;+         if (iLR - 1.0 - x < HM)+            HM = iLR - 1.0 - x;+         if (iLR - x > HP)+            HP = iLR - x;+         if (Q->V[i] >= tt0) {+            if (iLR / x > GP)+               GP = iLR / x;+            if ((iLR - 1.0) / x < GM)+               GM = (iLR - 1.0) / x;+         }+      }+   }++   res->pVal[snpair_GPlus] = 1.0 - FDistGPlus (Bidon, GP);+   res->sVal[snpair_GPlus] = GP;+   res->pVal[snpair_GMinus] = 1.0 - FDistGMinus (Bidon, GM);+   res->sVal[snpair_GMinus] = GM;+   res->pVal[snpair_HPlus] = 1.0 - FDistHPlus (Bidon, HP);+   res->sVal[snpair_HPlus] = HP;+   res->pVal[snpair_HMinus] = 1.0 - FDistHMinus (Bidon, HM);+   res->sVal[snpair_HMinus] = HM;++   if (swrite_Basic) {+      printf ("Test on the statistic G+              :");+      gofw_Writep2 (GP, res->pVal[snpair_GPlus]);+      printf ("\nTest on the statistic G-              :");+      gofw_Writep2 (GM, res->pVal[snpair_GMinus]);+      printf ("\nTest on the statistic H+              :");+      gofw_Writep2 (HP, res->pVal[snpair_HPlus]);+      printf ("\nTest on the statistic H-              :");+      gofw_Writep2 (HM, res->pVal[snpair_HMinus]);+      printf ("\n");+   }+}++#endif++/*=========================================================================*/++static void InitBBp0k2 (void)+/* + * Initialize Bickel-Breiman distribution with p = 0, k = 2+ */+{+   BB2[0] = 0.0;+   BB2[1] = 6.6022859e-5;+   BB2[2] = 2.111e-3;+   BB2[3] = 1.10679e-2;+   BB2[4] = 2.99898e-2;+   BB2[5] = 5.80398e-2;+   BB2[6] = 9.31672e-2;+   BB2[7] = 1.326804e-1;+   BB2[8] = 1.743017e-1;+   BB2[9] = 2.168632e-1;+   BB2[10] = 2.589057e-1;+   BB2[11] = 2.996407e-1;+   BB2[12] = 3.387514e-1;+   BB2[13] = 3.758668e-1;+   BB2[14] = 4.108985e-1;+   BB2[15] = 4.442291e-1;+   BB2[16] = 4.757295e-1;+   BB2[17] = 5.053408e-1;+   BB2[18] = 5.330166e-1;+   BB2[19] = 5.589979e-1;+   BB2[20] = 0.58358;+   BB2[21] = 6.067753e-1;+   BB2[22] = 6.281726e-1;+   BB2[23] = 6.483016e-1;+   BB2[24] = 6.670896e-1;+   BB2[25] = 6.848204e-1;+   BB2[26] = 7.016251e-1;+   BB2[27] = 7.17358e-1;+   BB2[28] = 7.319895e-1;+   BB2[29] = 7.458925e-1;+   BB2[30] = 7.589198e-1;+   BB2[31] = 7.712947e-1;+   BB2[32] = 7.82992e-1;+   BB2[33] = 7.939033e-1;+   BB2[34] = 8.044324e-1;+   BB2[35] = 8.14079e-1;+   BB2[36] = 8.233257e-1;+   BB2[37] = 8.319796e-1;+   BB2[38] = 8.402721e-1;+   BB2[39] = 0.84794;+   BB2[40] = 8.55173e-1;+   BB2[41] = 8.621625e-1;+   BB2[42] = 8.686291e-1;+   BB2[43] = 8.748893e-1;+   BB2[44] = 8.809175e-1;+   BB2[45] = 8.864606e-1;+   BB2[46] = 8.918151e-1;+   BB2[47] = 8.968588e-1;+   BB2[48] = 9.016258e-1;+   BB2[49] = 9.061704e-1;+   BB2[50] = 9.104084e-1;+   BB2[51] = 9.143753e-1;+   BB2[52] = 9.182571e-1;+   BB2[53] = 9.219001e-1;+   BB2[54] = 9.254505e-1;+   BB2[55] = 9.28772e-1;+   BB2[56] = 9.320133e-1;+   BB2[57] = 9.351203e-1;+   BB2[58] = 9.380936e-1;+   BB2[59] = 9.408087e-1;+   BB2[60] = 9.434704e-1;+   BB2[61] = 9.459541e-1;+   BB2[62] = 9.483018e-1;+   BB2[63] = 0.95057;+   BB2[64] = 9.526812e-1;+   BB2[65] = 9.547303e-1;+   BB2[66] = 9.566821e-1;+   BB2[67] = 9.585939e-1;+   BB2[68] = 9.603836e-1;+   BB2[69] = 9.62073e-1;+   BB2[70] = 9.637419e-1;+   BB2[71] = 9.652689e-1;+   BB2[72] = 9.666498e-1;+   BB2[73] = 9.680299e-1;+   BB2[74] = 9.693984e-1;+   BB2[75] = 9.707229e-1;+   BB2[76] = 9.720219e-1;+   BB2[77] = 9.731801e-1;+   BB2[78] = 9.742979e-1;+   BB2[79] = 9.753166e-1;+   BB2[80] = 9.763355e-1;+   BB2[81] = 9.773626e-1;+   BB2[82] = 9.782835e-1;+   BB2[83] = 9.792146e-1;+   BB2[84] = 9.800791e-1;+   BB2[85] = 9.808841e-1;+   BB2[86] = 9.816958e-1;+   BB2[87] = 9.824477e-1;+   BB2[88] = 9.831492e-1;+   BB2[89] = 9.838786e-1;+   BB2[90] = 9.845241e-1;+   BB2[91] = 9.851295e-1;+   BB2[92] = 9.857702e-1;+   BB2[93] = 9.863849e-1;+   BB2[94] = 9.869562e-1;+   BB2[95] = 9.875006e-1;+   BB2[96] = 9.879895e-1;+   BB2[97] = 9.88473e-1;+   BB2[98] = 9.889793e-1;+   BB2[99] = 9.894184e-1;+   BB2[100] = 9.898547e-1;+   BB2[101] = 9.902526e-1;+   BB2[102] = 9.906462e-1;+   BB2[103] = 9.910496e-1;+   BB2[104] = 9.914303e-1;+   BB2[105] = 9.918174e-1;+   BB2[106] = 9.921392e-1;+   BB2[107] = 9.924491e-1;+   BB2[108] = 9.92784e-1;+   BB2[109] = 9.930638e-1;+   BB2[110] = 9.933363e-1;+   BB2[111] = 9.936298e-1;+   BB2[112] = 9.93886e-1;+   BB2[113] = 9.941112e-1;+   BB2[114] = 9.943411e-1;+   BB2[115] = 9.945669e-1;+   BB2[116] = 9.947672e-1;+   BB2[117] = 9.94994e-1;+   BB2[118] = 9.951802e-1;+   BB2[119] = 9.953648e-1;+   BB2[120] = 9.955457e-1;+   BB2[121] = 9.957099e-1;+   BB2[122] = 9.959196e-1;+   BB2[123] = 9.961046e-1;+   BB2[124] = 9.962811e-1;+   BB2[125] = 9.964261e-1;+   BB2[126] = 9.965653e-1;+   BB2[127] = 9.967088e-1;+   BB2[128] = 0.99684;+   BB2[129] = 9.969537e-1;+   BB2[130] = 9.970835e-1;+   BB2[131] = 9.972087e-1;+}+++/*-------------------------------------------------------------------------*/++static void InitBBp2k2 (void)+/* + * Initialize Bickel-Breiman distribution with p = 2, k = 2+ */+{+   BB4[0] = -8.2912955e-1;+   BB4[1] = -9.4432194e-1;+   BB4[2] = -1.0567132;+   BB4[3] = -1.1679847;+   BB4[4] = -1.2776563;+   BB4[5] = -1.384483;+   BB4[6] = -1.4916059;+   BB4[7] = -1.5956447;+   BB4[8] = -1.6994536;+   BB4[9] = -1.8012517;+   BB4[10] = -1.9014279;+   BB4[11] = -2.0006153;+   BB4[12] = -2.0997178;+   BB4[13] = -2.1987994;+   BB4[14] = -2.2959638;+   BB4[15] = -2.391997;+   BB4[16] = -2.4867876;+   BB4[17] = -2.5815698;+   BB4[18] = -2.6761017;+   BB4[19] = -2.7658218;+   BB4[20] = -2.8582757;+   BB4[21] = -2.9522569;+   BB4[22] = -3.0406141;+   BB4[23] = -3.1311066;+   BB4[24] = -3.2179075;+   BB4[25] = -3.3057192;+   BB4[26] = -3.3933087;+   BB4[27] = -3.4815725;+   BB4[28] = -3.5719191;+   BB4[29] = -3.6592077;+   BB4[30] = -3.7437809;+   BB4[31] = -3.8274559;+   BB4[32] = -3.9149689;+   BB4[33] = -4.000307;+   BB4[34] = -4.0874655;+   BB4[35] = -4.1724253;+   BB4[36] = -4.2619679;+   BB4[37] = -4.3498336;+   BB4[38] = -4.4349335;+   BB4[39] = -4.5214761;+   BB4[40] = -4.607099;+   BB4[41] = -4.6921565;+   BB4[42] = -4.7799781;++   BB5[0] = -4.5909e-3;+   BB5[1] = -3.666e-4;+   BB5[2] = 7.508e-5;+   BB5[3] = 2.15483e-3;+   BB5[4] = 1.115755e-2;+   BB5[5] = 3.033271e-2;+   BB5[6] = 5.881422e-2;+   BB5[7] = 9.422896e-2;+   BB5[8] = 1.3423286e-1;+   BB5[9] = 1.7618124e-1;+   BB5[10] = 2.1865118e-1;+   BB5[11] = 2.6082507e-1;+   BB5[12] = 3.0215075e-1;+   BB5[13] = 3.4140313e-1;+   BB5[14] = 3.7898955e-1;+   BB5[15] = 4.1454877e-1;+   BB5[16] = 4.4830003e-1;+   BB5[17] = 4.7980029e-1;+   BB5[18] = 5.093375e-1;+   BB5[19] = 5.3717465e-1;+   BB5[20] = 5.6357091e-1;+   BB5[21] = 5.8817876e-1;+}+++/*-------------------------------------------------------------------------*/++static void InitBBp0k15 (void)+/* + * Initialize Bickel-Breiman distribution with p = 0, k = 15+ */+{+   BB3[0] = 0.0;+   BB3[1] = 1.6778e-4;+   BB3[2] = 2.6967455e-3;+   BB3[3] = 1.28187e-2;+   BB3[4] = 3.25519e-2;+   BB3[5] = 0.06001;+   BB3[6] = 9.28778e-2;+   BB3[7] = 1.292254e-1;+   BB3[8] = 1.674211e-1;+   BB3[9] = 2.066797e-1;+   BB3[10] = 2.439418e-1;+   BB3[11] = 2.805974e-1;+   BB3[12] = 3.156376e-1;+   BB3[13] = 3.487236e-1;+   BB3[14] = 3.804003e-1;+   BB3[15] = 4.103833e-1;+   BB3[16] = 4.394161e-1;+   BB3[17] = 4.673735e-1;+   BB3[18] = 4.935018e-1;+   BB3[19] = 5.181638e-1;+   BB3[20] = 5.403617e-1;+   BB3[21] = 5.609553e-1;+   BB3[22] = 5.813387e-1;+   BB3[23] = 6.003938e-1;+   BB3[24] = 6.188892e-1;+   BB3[25] = 6.353537e-1;+   BB3[26] = 6.509678e-1;+   BB3[27] = 6.658608e-1;+   BB3[28] = 6.797704e-1;+   BB3[29] = 6.93198e-1;+   BB3[30] = 7.059891e-1;+   BB3[31] = 7.185495e-1;+   BB3[32] = 7.306549e-1;+   BB3[33] = 7.413516e-1;+   BB3[34] = 7.517439e-1;+   BB3[35] = 7.617069e-1;+   BB3[36] = 7.709877e-1;+   BB3[37] = 7.804121e-1;+   BB3[38] = 7.898275e-1;+   BB3[39] = 7.984594e-1;+   BB3[40] = 8.058125e-1;+   BB3[41] = 8.129582e-1;+   BB3[42] = 8.199078e-1;+   BB3[43] = 8.26626e-1;+   BB3[44] = 8.332602e-1;+   BB3[45] = 8.393936e-1;+   BB3[46] = 8.452292e-1;+   BB3[47] = 8.510694e-1;+   BB3[48] = 8.569731e-1;+   BB3[49] = 8.621826e-1;+   BB3[50] = 8.671328e-1;+   BB3[51] = 8.723293e-1;+   BB3[52] = 8.770461e-1;+   BB3[53] = 8.814338e-1;+   BB3[54] = 8.853624e-1;+   BB3[55] = 8.897322e-1;+   BB3[56] = 8.937578e-1;+   BB3[57] = 8.97254e-1;+   BB3[58] = 9.008031e-1;+   BB3[59] = 9.042233e-1;+   BB3[60] = 9.076829e-1;+   BB3[61] = 9.11218e-1;+   BB3[62] = 9.139078e-1;+   BB3[63] = 9.170002e-1;+   BB3[64] = 9.199191e-1;+   BB3[65] = 9.226127e-1;+   BB3[66] = 9.250731e-1;+   BB3[67] = 9.277341e-1;+   BB3[68] = 9.301693e-1;+   BB3[69] = 9.324761e-1;+   BB3[70] = 9.347405e-1;+   BB3[71] = 9.370394e-1;+   BB3[72] = 9.390614e-1;+   BB3[73] = 9.41111e-1;+   BB3[74] = 9.429319e-1;+   BB3[75] = 9.448513e-1;+   BB3[76] = 9.466235e-1;+   BB3[77] = 9.483763e-1;+   BB3[78] = 9.500882e-1;+   BB3[79] = 9.517579e-1;+   BB3[80] = 9.531616e-1;+   BB3[81] = 9.546471e-1;+   BB3[82] = 9.561263e-1;+   BB3[83] = 9.576014e-1;+   BB3[84] = 9.592471e-1;+   BB3[85] = 9.605977e-1;+   BB3[86] = 9.618122e-1;+   BB3[87] = 9.632723e-1;+   BB3[88] = 9.644877e-1;+   BB3[89] = 9.654043e-1;+   BB3[90] = 9.666469e-1;+   BB3[91] = 9.676583e-1;+   BB3[92] = 9.687529e-1;+   BB3[93] = 9.697718e-1;+   BB3[94] = 9.708359e-1;+   BB3[95] = 9.716986e-1;+   BB3[96] = 9.726066e-1;+   BB3[97] = 9.734057e-1;+   BB3[98] = 9.743224e-1;+   BB3[99] = 9.751716e-1;+   BB3[100] = 9.759489e-1;+   BB3[101] = 9.766958e-1;+   BB3[102] = 9.774256e-1;+   BB3[103] = 9.783317e-1;+   BB3[104] = 9.789422e-1;+   BB3[105] = 9.795293e-1;+   BB3[106] = 9.801187e-1;+   BB3[107] = 9.807522e-1;+   BB3[108] = 9.812972e-1;+   BB3[109] = 9.818664e-1;+   BB3[110] = 9.825167e-1;+   BB3[111] = 9.831091e-1;+   BB3[112] = 9.835873e-1;+   BB3[113] = 9.840919e-1;+   BB3[114] = 9.845122e-1;+   BB3[115] = 9.850374e-1;+   BB3[116] = 9.854874e-1;+   BB3[117] = 9.859857e-1;+   BB3[118] = 9.865129e-1;+   BB3[119] = 9.869294e-1;+   BB3[120] = 9.873618e-1;+   BB3[121] = 9.877482e-1;+   BB3[122] = 9.880475e-1;+}+++/*-------------------------------------------------------------------------*/++static double FDistBBp0k2 (double junk[], double x)+/*+ * Bickel-Breiman distribution obtained by simulation with + *    N = 1000000,  n = 1000,  r = 0,  k =  2,  p = 0,  Torus =  TRUE+ * + * We first interpolated the empirical distribution on the points xs = j/100+ * (integer j) by building a parabola using a least-square fit with all+ * the points in [xs - 0.005, xs + 0.005], and then by computing ys(xs) on+ * the parabola, in order to reduce the noise. + * We use a Newton cubic interpolation with the 4 points closest to x to + * compute the distribution y(x).+ */+{+   static lebool BBp0k2Flag = FALSE;+   int j;+   double q;+   double y;+   if (x >= 6.0)+      return 1.0;+   if (x >= 1.3)+      return 1.0 - exp (-5.94558e-1 - 3.99672 * x);+   if (x <= 0.014)+      return 0.0;+   if (x <= 0.02) {+      return -2.66337e-3 + x * (5.12234e-1 + x * (-32.8023 + 701.167 * x));+   }++   if (FALSE == BBp0k2Flag) {+      InitBBp0k2 ();+      BBp0k2Flag = TRUE;+   }++   j = 100.0 * x + 2;             /* x is in [P(j-2), P(j-1)] */+   q = 100.0 * x - j;++   /* Newton backward cubic interpolation */+   y = BB2[j - 1] + (BB2[j - 1] - BB2[j - 2]) * q + (((BB2[j - 3]+            - 2.0 * BB2[j - 2]) + BB2[j - 1]) * q * (q + 1.0)) / 2.0+      + ((((-BB2[j - 4] + 3.0 * BB2[j - 3]) -+            3.0 * BB2[j - 2]) + BB2[j - 1]) * q * (q + 1.0) * (q ++         2.0)) / 6.0;++   return y;+}+++/*-------------------------------------------------------------------------*/++static double FDistBBp0k15 (double junk[], double x)+/*+ * Bickel-Breiman distribution obtained by simulation with + *    N = 100000,  n = 1000,  r = 0,  k =  15,  p = 0,  Torus =  TRUE+ * + * We first interpolated the empirical distribution on the points xs = j/100+ * (integer j) by building a parabola using a least-square fit with all+ * the points in [xs - 0.005, xs + 0.005], and then by computing ys(xs) on+ * the parabola, in order to reduce the noise. + * We use a Newton cubic interpolation with the 4 points closest to x to + * compute the distribution y(x).+ */+{+   static lebool BBp0k15Flag = FALSE;+   int j;+   double q;+   double y;+   if (x <= 0.015)+      return 0.0;+   if (x <= 0.02)+      return (6.1123 * x - 0.18384) * x + 1.3984e-3;+   if (x >= 6.0)+      return 1.0;+   if (x >= 1.2)+      return 1.0 - exp (-3.15786 * x - 5.41639e-1);++   if (FALSE == BBp0k15Flag) {+      InitBBp0k15 ();+      BBp0k15Flag = TRUE;+   }++   j = 100.0 * x + 2;             /* x is in [P(j-2), P(j-1)] */+   q = 100.0 * x - j;++   /* Newton backward cubic interpolation */+   y = (BB3[j - 1] - BB3[j - 2]) * q + BB3[j - 1] ++      (BB3[j - 3] - 2.0 * BB3[j - 2] + BB3[j - 1]) * q * (q + 1.0) / 2.0+      + (-BB3[j - 4] + 3.0 * BB3[j - 3] - 3.0 * BB3[j - 2]+      + BB3[j - 1]) * q * (q + 1.0) * (q + 2.0) / 6.0;++   return y;+}+++/*-------------------------------------------------------------------------*/++static double FDistBBp2k2 (double junk[], double x)+/*+ * Bickel-Breiman distribution obtained by simulation with + *    N = 1000000,  n = 1000,  r = 0,  k =  2,  p = 2,  Torus =  TRUE+ */+{+   static lebool BBp2k2Flag = FALSE;+   int j;+   double q;+   double y;+   if (x < 0.016)+      return 0.0;+   if (x >= 6.0)+      return 1.0;+   if (x >= 1.0)+      return 1.0 - exp ((0.1408724 * x - 4.485674) * x - 0.264116);++   if (FALSE == BBp2k2Flag) {+      InitBBp2k2 ();+      BBp2k2Flag = TRUE;+   }++   if (x >= 0.2) {+      /* Newton quadratic interpolation based on the points 0.02*j */+      /* in the interval [0.2, 1.0] */+      j = x * 50.0;+      q = x * 50.0 - j;+      y = BB4[j - 10] + q * (BB4[j - 9] - BB4[j - 10]) ++         (q * (q - 1.0) * ((BB4[j - 8] - 2.0 * BB4[j - 9]) + BB4[j -+               10])) / 2.0;++      return 1.0 - exp (y);+   }++   /* Newton backward cubic interpolation based on the points */+   /* 0.01*j in the interval [0, 0.2] */+   j = 100.0 * x + 2;             /* x is in [P(j-2), P(j-1)] */+   q = 100.0 * x - j;++   y = (BB5[j] - BB5[j - 1]) * q + BB5[j]+      + (((BB5[j - 2] - 2.0 * BB5[j - 1]) + BB5[j])+      * q * (q + 1.0)) / 2.0+      + ((((-BB5[j - 3] + 3.0 * BB5[j - 2]) - 3.0 * BB5[j - 1])+         + BB5[j]) * q * (q + 1.0) * (q + 2.0)) / 6.0;++   return y;+}+++/*-------------------------------------------------------------------------*/++void snpair_WriteDataBB (unif01_Gen * gen, char *TestName,+   long N, long n, int r, int k, int p, lebool Torus, int L1, int L2)+{+   double z;++   swrite_Head (gen, TestName, N, n, r);+   printf (",  k = %1d,  p = %1d,   Torus = ", k, p);+   util_WriteBool (Torus, 5);+   printf ("\n");++   if (swrite_Parameters) {+      printf ("\n   Seuil1 = %5d\n   Seuil2 = %5d\n   Seuil3 = %5d\n"+         "   Seuil4 = %5d\n   L1 = %2d\n   L2 = %2d\n",+         snpair_env.Seuil1, snpair_env.Seuil2, snpair_env.Seuil3,+         snpair_env.Seuil4, L1, L2);++      z = n * pow (2.0, -L1 * (double) k);+      printf ("   s1 = ");        /* n / 2^{k L1} = "); */+      num_WriteD (z, 9, 2, 2);+      printf ("\n   s2 = ");      /* n / 2^{k L2} = "); */+      z = n * pow (2.0, -L2 * (double) k);+      num_WriteD (z, 9, 2, 2);+   }+   printf ("\n\n\n");+}+++/*-------------------------------------------------------------------------*/++void snpair_WriteResultsBB (unif01_Gen * gen, chrono_Chrono * Timer,+   snpair_Res * res, long N)+{++   printf ("-----------------------------------------------\n");+   if (N == 1) {+      printf ("Value of the BB statistic             :");+      gofw_Writep2 (res->sVal[snpair_BB], res->pVal[snpair_BB]);+   } else {+      printf ("AD Statistic on the N p-values of BB  :");+      gofw_Writep2 (res->sVal[snpair_BB], res->pVal[snpair_BB]);+   }+   swrite_Final (gen, Timer);+}+++/*=========================================================================*/++void snpair_BickelBreiman (unif01_Gen * gen, snpair_Res * res,+   long N, long n, int r, int k, int p, lebool Torus)+{+   int j;+   long i;+   long Seq;+   snpair_PointType T;+   double mu1;                    /* -n * Vol */+   double ksurp;                  /* k / p */+   double Wni;+   double SumBB;+   double Vol;                    /* Volume of unit sphere in k dimension */+   double x, nLR, kLR;+   WorkType *work;+   lebool localRes = FALSE;+   chrono_Chrono *Timer, *Time1;+   char *TestName = "snpair_BickelBreiman test";++   Timer = chrono_Create ();++   if (res == NULL) {+      localRes = TRUE;+      res = snpair_CreateRes ();+   }+   work = res->work;+   work->Torus = Torus;+   work->kk = k;+   kLR = k;+   nLR = n;+   work->pp = p;+   work->mm = 1;+   work->mcd = 2;+   if (p == 0)+      work->pLR = 1.0;+   else+      work->pLR = p;+   work->Invp = 1.0 / work->pLR;+   ksurp = kLR / work->pLR;++   work->L1 = 1 + num_Log2 (nLR / snpair_env.Seuil3) / (sqrt (kLR));+   if (work->L1 < 2)+      work->L1 = 2;+   work->L2 = 1 + num_Log2 (nLR / snpair_env.Seuil4) / (sqrt (kLR));+   if (work->L2 < 2)+      work->L2 = 2;+   if (k < snpair_MAXREC)+      work->Maxnp = k;+   else+      work->Maxnp = snpair_MAXREC;+   Vol = num2_VolumeSphere ((double) p, k);+   mu1 = -nLR * Vol;+   work->BBFlag = TRUE;+   if (swrite_Basic)+      snpair_WriteDataBB (gen, TestName, N, n, r, k, p, Torus,+         work->L1, work->L2);++   /*  util_Assert (n <= snpair_MaxNumPoints,+       "snpair_BickelBreiman:   n is too large"); */+   util_Assert (p == 2 || p == 0,+      "snpair_BickelBreiman implemented only for p = 2 and p = 0");+   util_Assert (k == 2 || k == 15,+      "snpair_BickelBreiman implemented only for k = 2 and k = 15");+   util_Assert (p != 2 || k != 15,+      "snpair_BickelBreiman:   case p = 2, k = 15  not implemented");+   if (p == 0) {+      if (k == 2)+         work->FDistBB = FDistBBp0k2;+      else+         work->FDistBB = FDistBBp0k15;+   } else+      work->FDistBB = FDistBBp2k2;++   InitRes (res, N, n, 1);+   res->Distance = snpair_DistanceBB;+   res->VerifPairs = snpair_VerifPairs0;+   res->MiniProc = snpair_MiniProc1;+   statcoll_SetDesc (res->ThepValAD, "The N p-values of BickelBreiman");++   /* Test begins */+   for (Seq = 1; Seq <= N; Seq++) {++      for (i = 1; i <= n; i++) {+         /* Generate n points in dimension k */+         T = res->Points[1][i];+         /* Initialize nearest distance */+         T[0] = kLR;+         for (j = 1; j <= k; j++)+            T[j] = unif01_StripD (gen, r);+      }++      /* Find the closest points */+      work->dlim = kLR;            /* Initial upper bounds */+      work->dlimp = work->dlim;+      if (snpair_TimeBB)+         Time1 = chrono_Create ();+      snpair_QuickSort (res->Points[1], 1, n, 1);+      snpair_FindClosePairs (res, 1, n, 1, 1, 1);++      /* For each point, coordinate 0 now contains the distance to */+      /* the nearest point raised to power p (for p > 0) */+      snpair_QuickSort (res->Points[1], 1, n, 0);++      /* Compute the BB statistic, etc...  */+      SumBB = 0.0;+      for (i = 1; i <= n; i++) {+         Wni = 1.0 - exp (mu1 * pow (res->Points[1][i][0], ksurp));+         x = Wni - i / nLR;+         SumBB += x * x;+      }+      if (snpair_TimeBB) {+         printf ("   Time to compute the BB statistic:  ");+         chrono_Write (Time1, chrono_sec);+         printf ("\n");+         chrono_Delete (Time1);+      }+      statcoll_AddObs (res->ThepValAD,+         1.0 - work->FDistBB ((double *) NULL, SumBB));+   }++   if (swrite_Collectors)+      statcoll_Write (res->ThepValAD, 5, 14, 4, 3);++   if (N == 1) {+      res->sVal[snpair_BB] = SumBB;+      res->pVal[snpair_BB] = res->ThepValAD->V[1];+   } else {+      tables_QuickSortD (res->ThepValAD->V, 1, N);+      res->sVal[snpair_BB] = gofs_AndersonDarling (res->ThepValAD->V, N);+      res->pVal[snpair_BB] = fbar_AndersonDarling (N, res->sVal[snpair_BB]);+   }++   if (swrite_Basic)+      snpair_WriteResultsBB (gen, Timer, res, N);++   if (localRes)+      snpair_DeleteRes (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++void snpair_DistanceCPBitM (snpair_Res * res, snpair_PointType P1,+   snpair_PointType P2)+/*+ * Similar to snpair_DistanceCP, but for snpair_ClosePairsBitMatch. We take+ * at most two groups of SizeUL bits for each coordinate of two points and+ * find how many equal bits (= Y) they have before the first different bit,+ * starting with the most significant. That is the distance in 1 dimension.+ * We do that for each coordinate and the minimum of these is the distance+ * between the two points (all components of the pair have at least Y+ * identical bits).+ */+{+   const int NBitsUL = CHAR_BIT * sizeof (unsigned long);+   const double Mul = num_TwoExp[NBitsUL];+   unsigned long x1, x2, z;+   int i, j;+   int Y = INT_MAX;               /* Distance between the 2 points */+   WorkType *work = res->work;++   for (i = 1; i <= work->kk; i++) {+      /* Take the first NBitsUL bits of each coordinates of the 2 points */+      x1 = Mul * P1[i];+      x2 = Mul * P2[i];+      /* Find the position - 1 of the first (left) bit where they differ */+      z = x1 ^ x2;+      j = 0;+      if (z) {+         while (z < 2 * z) {+            j++;+            z <<= 1;+            if (j >= Y)+               continue;+         }+      } else {+         /* The first NBitsUL bits are equal, consider the NBitsUL next bits +          */+         x1 = Mul * (Mul * P1[i] - x1);+         x2 = Mul * (Mul * P2[i] - x2);+         z = x1 ^ x2;+         if (z) {+            j = NBitsUL;+            while (z < 2 * z) {+               j++;+               z <<= 1;+               if (j >= Y)+                  continue;+            }+         } else {+            j = 2 * NBitsUL;+         }+      }+      if (j < Y)+         Y = j;+      if (Y <= work->YLim)+         /* We want the maximum (amongst all pairs of points) of the */+         /* minimum Y over all coordinates of a pair. This pair cannot */+         /* give a larger YLim. */+         return;+   }++   /* A larger YLim has been found. From it, we define an inverse distance */+   /* so that the largest YLim gives the smallest new distance. This is */+   /* necessary if we want to use the fast but complicated algorithm for */+   /* finding the nearest pair. */+   if (Y > work->YLim) {+      work->YLim = Y;+      if (work->YLim <= num_MaxTwoExp)+         work->dlim = 1.0 / num_TwoExp[work->YLim];+      else+         work->dlim = pow (2.0, -(double) work->YLim);+      res->CloseDist[1] = work->dlim;+   }+}+++/*-------------------------------------------------------------------------*/++static void WriteDataBM (unif01_Gen * gen, char *TestName,+   long N, long n, int r, int k)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",  t = %1d\n\n", k);+}+++/*=========================================================================*/++void snpair_ClosePairsBitMatch (unif01_Gen * gen, snpair_Res * res,+   long N, long n, int r, int k)+/*+ * Similar to ClosePairs, but uses the BitMatch distance.+ */+{+   long Seq;+   double z1, nLR;+   snpair_PointType T;+   int m;+   int MaxY;                      /* Max of all bit distances */+   int j;+   long i;+   double pLeft, pRight;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "snpair_ClosePairsBitMatch test";+   WorkType *work;++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataBM (gen, TestName, N, n, r, k);++   /*  util_Assert (n <= snpair_MaxNumPoints,+       "snpair_ClosePairsBitMatch:   n > snpair_MaxNumPoints"); */+   util_Assert (n > 1, "snpair_ClosePairsBitMatch:   n < 2");+   if (res == NULL) {+      localRes = TRUE;+      res = snpair_CreateRes ();+   }+   work = res->work;+   work->Torus = FALSE;+   work->kk = k;+   work->mm = m = 1;+   work->mcd = 2 * m;+   nLR = n;+   work->Invp = work->pLR = work->pp = 1;++   if (k < snpair_MAXREC)+      work->Maxnp = k;+   else+      work->Maxnp = snpair_MAXREC;+   work->BBFlag = FALSE;           /* Bickel-Breiman Flag */++   CalcSeuils (work, k, m, FALSE, 0.0, nLR, (double) k);++   InitRes (res, N, n, m);+   res->Distance = snpair_DistanceCPBitM;+   res->VerifPairs = snpair_VerifPairs1;+   res->MiniProc = snpair_MiniProc1;++   MaxY = 0;++   /* Beginning of test */+   for (Seq = 1; Seq <= N; Seq++) {++      for (i = 1; i <= n; i++) {+         /* Generate n points in dimension k */+         T = res->Points[1][i];+         for (j = 1; j <= k; j++)+            T[j] = unif01_StripD (gen, r);+      }+      res->NumClose = 0;+      work->YLim = 0;              /* Initial lower bound */+      work->dlim = 1.0;            /* Initial upper bound */+      snpair_QuickSort (res->Points[1], 1, n, 1);+      snpair_FindClosePairs (res, 1, n, 1, 1, 1);++#if 0+      /* Check by computing distances between all pairs; very slow. */+      printf ("%12d", work->YLim);+      if (Seq % 5 == 0)+         printf ("\n");+      swrite_Collectors = TRUE;+      work->YLim = 0;+      snpair_VerifPairs0 (res->Points[1], 1, n, 0, 0);+#endif++      statcoll_AddObs (res->BitMax, (double) work->YLim);+      MaxY = util_Max (work->YLim, MaxY);+   }++   if (swrite_Collectors)+      statcoll_Write (res->BitMax, 5, 14, 4, 3);++   /* z1 = Probability [Min {k geometric (0.5)} >= MaxY] */+   if (k * (MaxY + 1) <= num_MaxTwoExp)+      z1 = 1.0 / num_TwoExp[k * (MaxY + 1)];+   else+      z1 = pow (2.0, -(double) k * (MaxY + 1));++   /* There are n*(n - 1)/2 pairs of points and we replicate that basic test +      N times, so we compute pLeft = the Probability [Max {N*n*(n - 1)/2 of+      above random var.} <= MaxY] */+   if (z1 > DBL_EPSILON) {+      pLeft = 1.0 - z1;+      z1 = log (pLeft) * N * n * (n - 1) / 2;+      pLeft = exp (z1);+      pRight = 1.0 - pLeft;+   } else {+      /* Use approximation log (1 - z) = -z to avoid loss of precision */+      pRight = z1 * N * n * (n - 1) / 2;+      pLeft = 1.0 - pRight;+   }+   res->pVal[snpair_BM] = gofw_pDisc (pLeft, pRight);+   res->sVal[snpair_BM] = MaxY;++   if (swrite_Basic) {+      printf ("\n-----------------------------------------------\n");+      printf ("Max of all bit distances              :");+      gofw_Writep2 ((double) MaxY, res->pVal[snpair_BM]);+      swrite_Final (gen, Timer);+   }++   if (localRes)+      snpair_DeleteRes (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/
+ cbits/testu/src/sres.c view
@@ -0,0 +1,273 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           sres.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "sres.h"+#include "fbar.h"++#include <string.h>+#include <math.h>+++++/*-------------------------------- Functions ------------------------------*/++++void sres_InitChi2 (sres_Chi2 *res, long N, long jmax, char *nam)+{+   statcoll_Init (res->sVal1, N);+   statcoll_Init (res->pVal1, N);++   if (jmax < 0) {+      if (res->jmax > 0) {+         res->NbExp = util_Free (res->NbExp);+         res->Count = util_Free (res->Count);+         res->Loc = util_Free (res->Loc);+      }+   } else {+      if (res->jmax < 0) {+         res->NbExp = util_Calloc ((size_t) (jmax + 1), sizeof (double));+         res->Count = util_Calloc ((size_t) (jmax + 1), sizeof (long));+         res->Loc = util_Calloc ((size_t) (jmax + 1), sizeof (long));+      } else {+         int j;+         res->NbExp =+            util_Realloc (res->NbExp, (jmax + 1) * sizeof (double));+         res->Count = util_Realloc (res->Count, (jmax + 1) * sizeof (long));+         res->Loc = util_Realloc (res->Loc, (jmax + 1) * sizeof (long));+         for (j = 0; j <= jmax; j++) {+            res->NbExp[j] = 0.0;+            res->Count[j] = 0;+            res->Loc[j] = 0;+         }+      }+   }+   res->degFree = 0;+   res->jmin = 0;+   res->jmax = jmax;+   gofw_InitTestArray (res->sVal2, -1.0);+   gofw_InitTestArray (res->pVal2, -1.0);+   res->name = util_Realloc (res->name, 1 + strlen (nam) * sizeof (char));+   strcpy (res->name, nam);+}+++/*-------------------------------------------------------------------------*/++sres_Chi2 *sres_CreateChi2 (void)+{+   sres_Chi2 *res;+   res = util_Malloc (sizeof (sres_Chi2));+   memset (res, 0, sizeof (sres_Chi2));+   res->sVal1 = statcoll_Create (1, "");+   res->pVal1 = statcoll_Create (1, "");+   res->name = util_Calloc (1, sizeof (char));+   res->jmin = 0;+   res->jmax = -1;+   res->NbExp = NULL;+   res->Count = NULL;+   res->Loc = NULL;+   return res;+}+++/*-------------------------------------------------------------------------*/++void sres_DeleteChi2 (sres_Chi2 * res)+{+   if (res == NULL)+      return;+   statcoll_Delete (res->sVal1);+   statcoll_Delete (res->pVal1);+   util_Free (res->NbExp);+   util_Free (res->Count);+   util_Free (res->Loc);+   util_Free (res->name);+   util_Free (res);+}+++/*-------------------------------------------------------------------------*/++void sres_GetChi2SumStat (sres_Chi2 *res)+{+   const long N = res->sVal1->NObs;+   double sum = N * statcoll_Average (res->sVal1);+   res->sVal2[gofw_Sum] = sum;+   if (N <= 1) {+      res->pVal2[gofw_Sum] = res->sVal1->V[1];+      res->sVal2[gofw_Var] = 0;+      return;+   }+   res->pVal2[gofw_Sum] = fbar_ChiSquare2 (N*res->degFree, 12, sum);+}+++/*=========================================================================*/++void sres_InitBasic (sres_Basic *res, long N, char *nam)+{+   statcoll_Init (res->sVal1, N);+   statcoll_Init (res->pVal1, N);+   gofw_InitTestArray (res->sVal2, -1.0);+   gofw_InitTestArray (res->pVal2, -1.0);+   res->name = util_Realloc (res->name, 1 + strlen (nam) * sizeof (char));+   strcpy (res->name, nam);+}+++/*-------------------------------------------------------------------------*/++sres_Basic *sres_CreateBasic (void)+{+   sres_Basic *res;+   res = util_Malloc (sizeof (sres_Basic));+   memset (res, 0, sizeof (sres_Basic));+   res->sVal1 = statcoll_Create (1, "");+   res->pVal1 = statcoll_Create (1, "");+   res->name = util_Calloc (1, sizeof (char));+   return res;+}+++/*-------------------------------------------------------------------------*/++void sres_DeleteBasic (sres_Basic * res)+{+   if (res == NULL)+      return;+   statcoll_Delete (res->sVal1);+   statcoll_Delete (res->pVal1);+   util_Free (res->name);+   util_Free (res);+}+++/*-------------------------------------------------------------------------*/++void sres_GetNormalSumStat (sres_Basic *res)+{+   const long N = res->sVal1->NObs;+   double sum = N * statcoll_Average (res->sVal1);+   res->sVal2[gofw_Sum] = sum;+   if (N <= 1) {+      res->pVal2[gofw_Sum] = res->sVal1->V[1];+      res->sVal2[gofw_Var] = 0;+      return;+   }+   res->pVal2[gofw_Sum] = fbar_Normal1 (sum/sqrt((double)N));+   sum = statcoll_Variance (res->sVal1);+   res->sVal2[gofw_Var] = sum;+   res->pVal2[gofw_Var] = fbar_ChiSquare2 (N - 1, 12, (N - 1)*sum);+}+++/*=========================================================================*/++void sres_InitPoisson (sres_Poisson *res, long N, double Lambda, char *nam)+{+   statcoll_Init (res->sVal1, N);+   res->Lambda = Lambda;+   res->Mu = N * Lambda;+   res->sVal2 = -1.0;+   res->pLeft = -1.0;+   res->pRight = -1.0;+   res->pVal2 = -1.0;+   res->name = util_Realloc (res->name, 1 + strlen (nam) * sizeof (char));+   strcpy (res->name, nam);+   +}+++/*-------------------------------------------------------------------------*/++sres_Poisson * sres_CreatePoisson (void)+{+   sres_Poisson *res;+   res = util_Malloc (sizeof (sres_Poisson));+   memset (res, 0, sizeof (sres_Poisson));+   res->sVal1 = statcoll_Create (1, "");+   res->name = util_Calloc (1, sizeof (char));+   return res;+}+++/*-------------------------------------------------------------------------*/++void sres_DeletePoisson (sres_Poisson *res)+{+   if (res == NULL)+      return;+   statcoll_Delete (res->sVal1);+   util_Free (res->name);+   util_Free (res);+}+++/*=========================================================================*/++void sres_InitDisc (sres_Disc *res, long N, char *nam)+{+   statcoll_Init (res->sVal1, N);+   res->sVal2 = -1.0;+   res->pLeft = -1.0;+   res->pRight = -1.0;+   res->pVal2 = -1.0;+   res->name = util_Realloc (res->name, 1 + strlen (nam) * sizeof (char));+   strcpy (res->name, nam);+   +}+++/*-------------------------------------------------------------------------*/++sres_Disc * sres_CreateDisc (void)+{+   sres_Disc *res;+   res = util_Malloc (sizeof (sres_Disc));+   memset (res, 0, sizeof (sres_Disc));+   res->sVal1 = statcoll_Create (1, "");+   res->name = util_Calloc (1, sizeof (char));+   return res;+}+++/*-------------------------------------------------------------------------*/++void sres_DeleteDisc (sres_Disc *res)+{+   if (res == NULL)+      return;+   statcoll_Delete (res->sVal1);+   util_Free (res->name);+   util_Free (res);+}
+ cbits/testu/src/sspectral.c view
@@ -0,0 +1,423 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           sspectral.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "num.h"+#include "chrono.h"+#include "tables.h"++#include "sspectral.h"+#include "swrite.h"+#include "wdist.h"+#include "unif01.h"++#include "gofw.h"+#include "statcoll.h"++#include "fftc.c"++#include <math.h>+#include <stdlib.h>+#include <string.h>+++++++/*-------------------------------- Functions ------------------------------*/+++static void InitRes (+   sspectral_Res *res,+   long N,+   long jmin,+   long jmax,+   char *nam+)+/* + * Initializes the sspectral_Res structure+ */+{+   long j;+   sres_InitBasic (res->Bas, N, nam);+   if (jmax > res->jmax)+      res->Coef = util_Realloc (res->Coef, (jmax + 200) * sizeof (double));+   for (j = 0; j <= jmax; j++)+      res->Coef[j] = 0.0;+   res->jmin = jmin;+   res->jmax = jmax;+   res->Bas->name = util_Realloc (res->Bas->name,+                                  1 + strlen (nam) * sizeof (char));+   strcpy (res->Bas->name, nam);+}+++/*-------------------------------------------------------------------------*/++sspectral_Res * sspectral_CreateRes (void)+{+   sspectral_Res *res;+   res = util_Malloc (sizeof (sspectral_Res));+   res->Bas = sres_CreateBasic ();+   res->Coef = util_Calloc (1, sizeof (double));+   res->jmax = 0;+   return res;+}+++/*-------------------------------------------------------------------------*/++void sspectral_DeleteRes (sspectral_Res *res)+{+   if (res == NULL)+      return;+   sres_DeleteBasic (res->Bas);+   util_Free (res->Coef);+   util_Free (res);+}+++/*=========================================================================*/++static void WriteDataFour (+   unif01_Gen *gen,      /* generator */+   char *Test,           /* Test name */+   long N,               /* Number of replications */+   int k,                /* Sample size n = 2^k */+   int r,                /* r first bits of each random number dropped */+   int s                 /* s bits of each random number used */+)+{+   long n;+   n = num_TwoExp[k];+   swrite_Head (gen, Test, N, n, r);+   printf (",   s = %4d,   k = %4d\n\n", s, k);+}+++/*-------------------------------------------------------------------------*/++void sspectral_Fourier1 (unif01_Gen *gen, sspectral_Res *res,+   long N, int t, int r, int s)+{+   const unsigned long SBIT = 1UL << (s - 1);+   unsigned long jBit;+   unsigned long Z;+   long k, KALL, Seq, n, i;+   double x, NbExp, h, per;+   long co;+   double *A;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sspectral_Fourier1 test";++   Timer = chrono_Create ();+   util_Assert (t <= 20, "sspectral_Fourier1:   k > 20");+   util_Assert (t > 1, "sspectral_Fourier1:   k < 2");+   if (swrite_Basic)+      WriteDataFour (gen, TestName, N, t, r, s);+   if (res == NULL) {+      localRes = TRUE;+      res = sspectral_CreateRes ();+   }+   n = num_TwoExp[t];+   KALL = n / s;+   if (n % s > 0)+      KALL++;+   per = 0.95;+   NbExp = per * (n / 2 + 1);+/*   h = 3.0 * n; */+   h = 2.995732274 * n;+   InitRes (res, N, 0, n, "sspectral_Fourier1");+   statcoll_SetDesc (res->Bas->sVal1, "sVal1:   a standard normal");+   A = res->Coef;++   for (Seq = 1; Seq <= N; Seq++) {+      /* Fill array A: 1 for bit 1, -1 for bit 0 */+      i = 0;+      for (k = 0; k < KALL; k++) {+         Z = unif01_StripB (gen, r, s);+         jBit = SBIT;+         while (jBit) {+            if (jBit & Z)+               A[i] = 1.0;+            else+               A[i] = -1.0;+            jBit >>= 1;+            i++;+         }+      }+      /* +       * Compute the Fourier transform of A and return the result in A. The+       * first half of the array, (from 0 to n/2) is filled with the real+       * components of the FFT. The second half of the array (from n/2+1 to+       * n-1) is filled with the imaginary components of the FFT.+       * The n new elements of A are thus:+       *      [Re(0), Re(1), ...., Re(n/2), Im(n/2-1), ..., Im(1)]+       * The procedure is due to H.V. Sorensen, University of Pennsylvania +       * and is found in file fftc.c.+       */+      rsrfft (A, t);++      /* Count the number of Fourier coefficients smaller than h */+      co = 0;+      for (i = 1; i < n / 2; i++) {+         x = A[i] * A[i] + A[n - i] * A[n - i];+         if (x < h)+            co++;+      }+      if (A[0] * A[0] < h)+         co++;++      /* Compute the NIST statistic */+      x = (co - NbExp) / sqrt (NbExp * (1.0 - per));+      statcoll_AddObs (res->Bas->sVal1, x);++      if (swrite_Counters) {+         tables_WriteTabD (res->Coef, 0, n - 1, 5, 14, 5, 5,+            "Fourier coefficients");+      }+   }++   gofw_ActiveTests2 (res->Bas->sVal1->V, res->Bas->pVal1->V, N, wdist_Normal,+      (double *) NULL, res->Bas->sVal2, res->Bas->pVal2);+   res->Bas->pVal1->NObs = N;+   sres_GetNormalSumStat (res->Bas);++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (N, res->Bas->sVal2, res->Bas->pVal2,+         "Normal statistic                      :");+      swrite_NormalSumTest (N, res->Bas);+      if (swrite_Collectors)+         statcoll_Write (res->Bas->sVal1, 5, 14, 4, 3);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sspectral_DeleteRes (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++void sspectral_Fourier3 (unif01_Gen *gen, sspectral_Res *res,+   long N, int t, int r, int s)+{+   const unsigned long SBIT = 1UL << (s - 1);+   unsigned long jBit;+   unsigned long Z;+   long k, KALL, Seq, n, i;+   double *A, *B;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sspectral_Fourier3 test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataFour (gen, TestName, N, t, r, s);+   util_Assert (r + s <= 32, "sspectral_Fourier3:   r + s > 32");+   util_Assert (t <= 26, "sspectral_Fourier3:   k > 26");+   util_Assert (t >= 2, "sspectral_Fourier3:   k < 2");+   if (res == NULL) {+      localRes = TRUE;+      res = sspectral_CreateRes ();+   }+   n = num_TwoExp[t];+   KALL = n / s + 1;+   InitRes (res, n/4 + 1, 0, n, "sspectral_Fourier3");+   statcoll_SetDesc (res->Bas->sVal1, "sVal1:   a standard normal");+   B = res->Bas->sVal1->V;+   A = res->Coef;+   for (i = 0; i <= n / 4; i++)+      B[i] = 0.0;++   for (Seq = 1; Seq <= N; Seq++) {+      /* Fill array A: 1 for bit 1, -1 for bit 0 */+      i = 0;+      for (k = 0; k < KALL; k++) {+         Z = unif01_StripB (gen, r, s);+         jBit = SBIT;+         while (jBit) {+            if (jBit & Z)+               A[i] = 1.0;+            else+               A[i] = -1.0;+            jBit >>= 1;+            i++;+         }+      }+      /* +       * Compute the Fourier transform of A and return the result in A. The+       * first half of the array, (from 0 to n/2) is filled with the real+       * components of the FFT. The second half of the array (from n/2+1 to+       * n-1) is filled with the imaginary components of the FFT.+       * The n new elements of A are thus:+       *      [Re(0), Re(1), ...., Re(n/2), Im(n/2-1), ..., Im(1)]+       * The procedure is due to H.V. Sorensen, University of Pennsylvania +       * and is found in file fftc.c.+       */+      rsrfft (A, t);++      /* Add the squares of the Fourier coefficients over the N replications+         for each i = [1, ..., n/4], and keep them in B[i] */+      for (i = 1; i <= n / 4; i++)+         B[i] += A[i] * A[i] + A[n - i] * A[n - i];++      if (0 && swrite_Counters)+	 tables_WriteTabD (B, 1, n / 4, 5, 14, 5, 5,+	     "Sums of square of Fourier coefficients");+   }++   /* There is an extra sqrt (n) factor between the Fourier coefficients+      of Sorensen and those of Erdmann */+   for (i = 1; i <= n / 4; i++)+      B[i] /= n;++   /* The N random variables have been added for each i and kept in B[i].+      Their mean (1) and variance (~1) is known from Diane Erdmann. Now+      consider the B[i] as n/4 normal random variables. */+   for (i = 1; i <= n / 4; i++) {+      B[i] = (B[i] - N) / sqrt (N * (1.0 - 2.0 / n));+      statcoll_AddObs (res->Bas->sVal1, B[i]);+   }++   gofw_ActiveTests2 (res->Bas->sVal1->V, res->Bas->pVal1->V, n/4, wdist_Normal,+      (double *) NULL, res->Bas->sVal2, res->Bas->pVal2);+   res->Bas->pVal1->NObs = n/4;++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (n/4, res->Bas->sVal2, res->Bas->pVal2,+         "Normal statistic                      :");+      if (swrite_Collectors)+         statcoll_Write (res->Bas->sVal1, 5, 14, 4, 3);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sspectral_DeleteRes (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++void sspectral_Fourier2 (unif01_Gen *gen, sspectral_Res *res,+   long N, int t, int r, int s)+{+   const unsigned long SBIT = 1UL << (s - 1);+   unsigned long jBit;+   unsigned long Z;+   long k, KALL, Seq, n, i;+   double *A;+   double x, sum;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sspectral_Fourier2 test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataFour (gen, TestName, N, t, r, s);+   util_Assert (r + s <= 32, "sspectral_Fourier2:   r + s > 32");+   util_Assert (t <= 26, "sspectral_Fourier2:   k > 26");+   util_Assert (t >= 2, "sspectral_Fourier2:   k < 2");+   if (res == NULL) {+      localRes = TRUE;+      res = sspectral_CreateRes ();+   }+   n = num_TwoExp[t];+   KALL = n / s + 1;+   InitRes (res, N, 0, n, "sspectral_Fourier2");+   statcoll_SetDesc (res->Bas->sVal1, "sVal1:   a standard normal");+   A = res->Coef;++   for (Seq = 1; Seq <= N; Seq++) {+      /* Fill array A: 1 for bit 1, -1 for bit 0 */+      i = 0;+      for (k = 0; k < KALL; k++) {+         Z = unif01_StripB (gen, r, s);+         jBit = SBIT;+         while (jBit) {+            if (jBit & Z)+               A[i] = 1.0;+            else+               A[i] = -1.0;+            jBit >>= 1;+            i++;+         }+      }+      /* +       * Compute the Fourier transform of A and return the result in A. The+       * first half of the array, (from 0 to n/2) is filled with the real+       * components of the FFT. The second half of the array (from n/2+1 to+       * n-1) is filled with the imaginary components of the FFT.+       * The n new elements of A are thus:+       *      [Re(0), Re(1), ...., Re(n/2), Im(n/2-1), ..., Im(1)]+       * The procedure is due to H.V. Sorensen, University of Pennsylvania +       * and is found in file fftc.c.+       */+      rsrfft (A, t);++      /* Sum the square of the Fourier coefficients (only half of them) */+      sum = 0.0;+      for (i = 1; i <= n / 4; i++)+         sum += A[i] * A[i] + A[n - i] * A[n - i];++      /* There is an extra sqrt (n) factor between the Fourier coefficients+         of Sorensen and those of Erdmann */+      sum /= n;++      /* Standardize the statistic */+      x = 2.0*(sum - n / 4.0) / sqrt (n - 2.0);+      statcoll_AddObs (res->Bas->sVal1, x);++      if (swrite_Counters) {+         tables_WriteTabD (res->Coef, 0, n - 1, 5, 14, 5, 5,+            "Fourier coefficients");+      }+   }++   gofw_ActiveTests2 (res->Bas->sVal1->V, res->Bas->pVal1->V, N, wdist_Normal,+      (double *) NULL, res->Bas->sVal2, res->Bas->pVal2);+   res->Bas->pVal1->NObs = N;+   sres_GetNormalSumStat (res->Bas);++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (N, res->Bas->sVal2, res->Bas->pVal2,+         "Normal statistic                      :");+      swrite_NormalSumTest (N, res->Bas);+      if (swrite_Collectors)+         statcoll_Write (res->Bas->sVal1, 5, 14, 4, 3);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sspectral_DeleteRes (res);+   chrono_Delete (Timer);+}+
+ cbits/testu/src/sstring.c view
@@ -0,0 +1,2268 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           sstring.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "chrono.h"+#include "num.h"+#include "tables.h"+#include "bitset.h"++#include "sstring.h"+#include "unif01.h"+#include "wdist.h"+#include "swrite.h"+#include "sres.h"++#include "gofs.h"+#include "gofw.h"+#include "fbar.h"+#include "statcoll.h"++#include <math.h>+#include <float.h>+#include <limits.h>+#include <stdio.h>+#include <string.h>++++++/*------------------------------ Constants --------------------------------*/++/* Minimal length (number of bits) of a sequence for LongestHeadRun */+#define LMIN 1000++/* Max string length for the correlations in PeriodsInStrings */+#define MAX_CORR 31++/* Max dimension of arrays */+#define DIM 1000++/* Max string lengths */+#define LEN1 200+#define LEN2 200++++++/*-------------------------------- Types ----------------------------------*/++typedef struct InfoListC *ListC;     /* A correlation list */++struct InfoListC {+   long Nb;                          /* Number of bits of a correlation in+                                        the initial computations; then+                                        number of occurences */+   bitset_BitSet C;                  /* A correlation */+   long Pop;                         /* Population related to C (and c) */+   ListC Ext;                        /* The smallest extension of C */+   ListC Ext0;                       /* The smallest extension of D longer+                                        than C, if C is an extension of D.+                                        Initially NULL */+   ListC Next;                       /* Next correlation of same length */+};++/* Corr contains the lists of correlations of each length for s in [0..smax]+ */+typedef struct {+   ListC Corr[MAX_CORR + 1];+   int smax;+} sstring_Corr;+++/*----------------------------- Variables --------------------------------*/++lebool sstring_CorrFlag = FALSE;+lebool sstring_Counters = FALSE;+++++/*----------------------------- Functions --------------------------------*/++static void InitRes3 (+   sstring_Res3 *res,         /* Results holder */+   long N,                    /* Number of replications */+   int jmax                   /* Max class index for chi2 */+)+/* + * Initializes the sstring_Res3 structure+ */+{+   sres_InitBasic (res->NBits, N, "sstring_Run:   Number of Bits");+   sres_InitChi2 (res->NRuns, N, jmax, "sstring_Run:   Number of Runs");+   res->Count0 = util_Realloc (res->Count0, (jmax + 1) * sizeof (long));+   res->Count1 = util_Realloc (res->Count1, (jmax + 1) * sizeof (long));+   res->NRuns->jmin = 1;+   res->NRuns->degFree = jmax - 1;+}+++/*-------------------------------------------------------------------------*/++sstring_Res3 * sstring_CreateRes3 (void)+{+   sstring_Res3 *res;+   res = util_Malloc (sizeof (sstring_Res3));+   res->NBits = sres_CreateBasic ();+   res->NRuns = sres_CreateChi2 ();+   res->Count0 = util_Calloc (1, sizeof (long));+   res->Count1 = util_Calloc (1, sizeof (long));+   return res;+}+++/*-------------------------------------------------------------------------*/++void sstring_DeleteRes3 (sstring_Res3 *res)+{+   if (res == NULL)+      return;+   res->Count0 = util_Free (res->Count0);+   res->Count1 = util_Free (res->Count1);+   sres_DeleteBasic (res->NBits);+   sres_DeleteChi2 (res->NRuns);+   util_Free (res);+}+++/*=========================================================================*/++static void InitRes2 (+   sstring_Res2 *res,         /* Results holder */+   long N,                    /* Number of replications */+   int jhigh                  /* Max class index for chi2 */+)+/* + * Initializes the sstring_Res2 structure+ */+{+   sres_InitDisc (res->Disc, N,+      "sstring_LongestHeadRun:   Global longest run of 1's");+   sres_InitChi2 (res->Chi, N, jhigh,+      "sstring_LongestHeadRun:   Block longest runs of 1's");+}+++/*-------------------------------------------------------------------------*/++sstring_Res2 * sstring_CreateRes2 (void)+{+   sstring_Res2 *res;+   res = util_Malloc (sizeof (sstring_Res2));+   res->Chi = sres_CreateChi2 ();+   res->Disc = sres_CreateDisc ();+   return res;+}+++/*-------------------------------------------------------------------------*/++void sstring_DeleteRes2 (sstring_Res2 *res)+{+   if (res == NULL)+      return;+   sres_DeleteChi2 (res->Chi);+   sres_DeleteDisc (res->Disc);+   util_Free (res);+}+++/*=========================================================================*/++static void InitRes (+   sstring_Res *res,          /* Results holder */+   long N,                    /* Number of replications */+   int L,                     /* Size of blocks (number of bits) */+   int d,                     /* Parameter for sub-matrices */+   char *nam+)+/* + * Initializes res+ */+{+   int i;+   sres_InitBasic (res->Bas, N, nam);++   if (res->L > 0) {+      tables_DeleteMatrixL (&res->Counters);+      tables_DeleteMatrixD (&res->ZCounters);+   }+   res->Counters = tables_CreateMatrixL (L + 2, L + 1);+   res->ZCounters = tables_CreateMatrixD (L + 2, L + 1);++   if (d < 0)+      d = 0;+   for (i = d + 1; i <= res->d; i++)+      sres_DeleteBasic (res->Block[i]);++   for (i = res->d + 1; i <= d; i++)+      res->Block[i] = sres_CreateBasic ();++   for (i = 1; i <= d; i++)+      sres_InitBasic (res->Block[i], N, nam);++   res->L = L;+   res->d = d;+}+++/*-------------------------------------------------------------------------*/++sstring_Res * sstring_CreateRes (void)+{+   sstring_Res *res;+   res = util_Malloc (sizeof (sstring_Res));+   memset (res, 0, sizeof (sstring_Res));+   res->Bas = sres_CreateBasic ();+   res->Style = tables_Plain;+   res->L = -1;+   res->d = 0;+   return res;+}+++/*-------------------------------------------------------------------------*/++void sstring_DeleteRes (sstring_Res *res)+{+   if (res == NULL)+      return;++   if (res->d > 0) {+      int i;+      for (i = 1; i <= res->d; i++) {+         sres_DeleteBasic (res->Block[i]);+      }+   }+   if (res->L > 0) {+      tables_DeleteMatrixD (&res->ZCounters);+      tables_DeleteMatrixL (&res->Counters);+   }+   sres_DeleteBasic (res->Bas);+   util_Free (res);+}+++/*=========================================================================*/++static long Psi (+   bitset_BitSet C,      /* Correlation making up tail of correlation k */+   long j,               /* Length of correlation C */+   long k                /* Correlation made up of 1 followed by 0's +                            until C, i.e. k = 100...000C */+)+{+   /* j <=> c & k <=> k in the article */+   if (k > j)+      return 0;+   if (k <= 0)+      return (long) num_TwoExp[-k];+   if (bitset_TestBit (C, j - k))+      return 1;+   else+      return 0;+}+++/*-------------------------------------------------------------------------*/++static void DeleteCorr (sstring_Corr *corr)+/*+ * Delete all correlations.+ */+{+   ListC Ci, OldCi;+   int i;++   if (corr == NULL)+      return;+   for (i = 0; i <= corr->smax; i++) {+      Ci = corr->Corr[i];+      while (Ci) {+         OldCi = Ci;+         Ci = Ci->Next;+         util_Free (OldCi);+      }+   }+   util_Free (corr);+}+++/*-------------------------------------------------------------------------*/++static sstring_Corr * CreateCorr (int s)+/*+ * Compute all possible correlations for strings of length s+ */+{+   ListC CjE, Cj, Ci, OldCi, XS;+   sstring_Corr *corr;+   int j, i, k, Tmax;+   long p;++   corr = util_Malloc (sizeof (sstring_Corr));+   memset (corr, 0, sizeof (sstring_Corr));++   corr->smax = s;++   XS = corr->Corr[0] = util_Malloc (sizeof (struct InfoListC));+   XS->Nb = 0;+   XS->Pop = 1;+   XS->Ext = NULL;+   XS->Ext0 = NULL;+   XS->Next = NULL;++   XS = corr->Corr[1] = util_Malloc (sizeof (struct InfoListC));+   XS->Nb = 1;+   bitset_SetBit (XS->C, 0);+   XS->Pop = 2;+   XS->Ext = NULL;+   XS->Ext0 = NULL;+   XS->Next = NULL;++   for (i = 2; i <= s; i++) {            /* i is the string length */+      /* Count and build the list of correlations of length i. */+      Ci = corr->Corr[i] = util_Malloc (sizeof (struct InfoListC));++      for (j = 0; j <= i - 2; j++) {+         /* j is the length of correlation C in 100...00C */+         Cj = corr->Corr[j];++	 while (Cj) {+	    /* Compute the number of strings of length i and with corre- */+	    /* lation "10...0C", and if > 0, add this corr. to Corr[i] */+	    p = Cj->Pop * Psi (Cj->C, j, 2*j - i);+	    /* Check if 1C may be a correlation. Possible only if+	       C = 111....1, i.e. the last of the list */+	    if (Cj->Next == NULL)+	       p -= 2 * Psi (Cj->C, j, 2*j + 2 - i);+	    CjE = Cj->Ext;+	    /* Note: j <= j-2, i.e.  j+1 <= (i+j) / 2  */+	    Tmax = (i + j) / 2;+	    while (CjE && CjE->Nb <= Tmax) {+	       p -= CjE->Pop * Psi (Cj->C, j, 2*CjE->Nb - i);+	       CjE = CjE->Ext0;+	    }+	    /* p = number of strings looked for */+	    if (p > 0) {+	       /* Put this correlation in Ci */+	       Ci->Nb = i;+	       Ci->Pop = p;+	       Ci->Ext = NULL;+	       Ci->Ext0 = NULL;+	       /* Ci->C becomes Cj->C shifted right by i-j  */+	       /* positions, with a 1 in first position.    */+	       Ci->C = 0;+	       bitset_SetBit (Ci->C, 0);+	       if (j > 0) {+		  for (k = 0; k < j; k++) {+		     if (bitset_TestBit (Cj->C, k)) {+			bitset_SetBit (Ci->C, k + i - j);+		     }+		  }+	       }+	       if (Cj->Ext == NULL)+		  Cj->Ext = Ci;+	       else {+		  CjE = Cj->Ext;+		  while (CjE->Ext0)+		     CjE = CjE->Ext0;+		  CjE->Ext0 = Ci;+	       }+	       OldCi = Ci;+	       Ci = util_Malloc (sizeof (struct InfoListC));+	       OldCi->Next = Ci;+	    }+	    Cj = Cj->Next;+	 }+      }+      /* For j = i-1, we have the correlation "11...1" */+      Ci->C = 0;+      for (k = 0; k < i; k++) {+         bitset_SetBit (Ci->C, k);+      }+      Ci->Nb = i;+      Ci->Pop = 2;+      Ci->Ext = NULL;+      Ci->Ext0 = NULL;+      Ci->Next = NULL;+   }+   return corr;+}+++/*=========================================================================*/++static void sstring_WriteCorr (sstring_Corr *corr, int s)+{+   ListC Cs;+   int k;+   char str [LEN1 + 1];++   if (corr == NULL) {+      util_Warning (TRUE,+         "sstring_WriteCorr:   corr is a NULL pointer");+      return;+   }++   if (corr->smax < s) {+      sprintf (str, "sstring_WriteCorr:   invalid s = %d", s);+      util_Error (str);+   }++   Cs = corr->Corr[s];+   if (Cs == NULL)+      return;+   printf ("\n-----------------------------------------------------\n"+      "List of correlations of length %d and their population\n\n", s);+   while (Cs) {+      for (k = 0; k < s; k++) {+         if (bitset_TestBit (Cs->C, k))+            printf ("1");+         else+            printf ("0");+      }+      printf ("%12ld\n", Cs->Pop);+      Cs = Cs->Next;+   }+   printf ("\n\n");+}+++/*-------------------------------------------------------------------------*/++static bitset_BitSet GenerateC (+   unif01_Gen *gen,      /* Generator */+   int r,                /* Drop first r bits of each random number */+   int s                 /* Keep next s bits of each random number */+)+/*+ * Generate a string of s bits and return its correlation. To determine the+ * correlation of a bit string, compare strings g and d (initially equal).+ * For each iteration:+ *     1) drop leftmost bit of string g+ *     2) drop rightmost bit of string d+ *     3) if g = d, bit k of the correlation c is 1, otherwise 0.+ */+{+   int k;+   unsigned long g, d, lbit = s - 1;+   bitset_BitSet c = 0;++   /* Generate a random number; drop r most significant bits; keep s next+      bits */+   g = d = unif01_StripB (gen, r, s);++   /* Initialization of correlation, trivial case */+   bitset_SetBit (c, 0);+   for (k = 1; k < s; k++) {+      /* drop leftmost bit of string g */+      bitset_ClearBit (g, lbit);+      /* drop rightmost bit of string d	*/+      d >>= 1;+      /* if g = d, bit k of the correlation c is 1, otherwise 0 */+      if (g == d)+         bitset_SetBit (c, k);+      lbit--;+   }+   return c;+}+++/*=========================================================================*/++static void WriteDataPeriod (+   unif01_Gen *gen,      /* generator */+   char *Test,           /* Test name */+   long N,               /* Number of replications */+   long n,               /* Sample size */+   int r,                /* r first bits of each random number dropped */+   int s                 /* s bits of each random number used */+)+{+   swrite_Head (gen, Test, N, n, r);+   printf (",   s = %4d\n\n", s);+}+++/*-------------------------------------------------------------------------*/++void sstring_PeriodsInStrings (unif01_Gen *gen, sres_Chi2 *res,+   long N, long n, int r, int s)+{+   ListC XS, Ci;+   sstring_Corr *corr;+   long jhigh,                     /* Highest class for ChiSquare */+        jlow,                      /* Lowest class for ChiSquare */+        NbGroups;                  /* Number of classes for ChiSquare */+   long j, i;+   long Seq;                       /* One replication of the test */+   double Fraction, X2;+   bitset_BitSet D;                /* A correlation */+   double V[1];                    /* Number of ChiSquare degrees of freedom */+   char str [LEN1 + 1];+   double NbExp [DIM + 1];+   long Loca [DIM + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sstring_PeriodsInStrings test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataPeriod (gen, TestName, N, n, r, s);++   util_Assert (r >= 0, "sstring_PeriodsInStrings:   r < 0");+   util_Assert (r <= 31, "sstring_PeriodsInStrings:   r > 31");+   util_Assert (r + s <= 31, "sstring_PeriodsInStrings:   r + s > 31");+   util_Assert (s <= 31, "sstring_PeriodsInStrings:   s > 31");+   util_Assert (s >= 2, "sstring_PeriodsInStrings:   s < 2");+   /*   util_Assert (n > 2.0 * gofs_MinExpected,+	"sstring_PeriodsInStrings:    n <= 2*gofs_MinExpected"); */++   Fraction = n / num_TwoExp[s];+   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   corr = CreateCorr (s);+   if (sstring_CorrFlag)+      sstring_WriteCorr (corr, s);++   /* Get the expected numbers of the population count */+   XS = Ci = corr->Corr[s];+   j = 1;+   while (Ci) {+      NbExp[j] = Fraction * Ci->Pop;+      Ci = Ci->Next;+      ++j;+      util_Assert (j <= DIM, "sstring_PeriodsInStrings:   DIM too small");+   }+   jlow = 1;+   jhigh = j - 1;++   if (swrite_Classes)+      gofs_WriteClasses (NbExp, Loca, jlow, jhigh, 0);++   /* Merge classes for the chi-square test */+   gofs_MergeClasses (NbExp, Loca, &jlow, &jhigh, &NbGroups);++   if (swrite_Classes)+      gofs_WriteClasses (NbExp, Loca, jlow, jhigh, NbGroups);++   res->degFree = NbGroups - 1;+   if (res->degFree < 1) {+      if (localRes)+         sres_DeleteChi2 (res);+      return;+   }+   sres_InitChi2 (res, N, jhigh, "sstring_PeriodsInStrings");+   res->jmin = jlow;+   tables_CopyTabD (NbExp, res->NbExp, jlow, jhigh);+   tables_CopyTabL (Loca, res->Loc, jlow, jhigh);++   sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"+                 " of freedom):", NbGroups - 1);+   statcoll_SetDesc (res->sVal1, str);++   /* Test begins */+   for (Seq = 1; Seq <= N; Seq++) {+      /* Zero the population counters */+      Ci = XS;+      while (Ci) {+         Ci->Nb = 0;+         Ci = Ci->Next;+      }+      for (i = 1; i <= n; i++) {+         D = GenerateC (gen, r, s);+         /* Find the correlation */+         Ci = XS;+         while (Ci->C != D)+            Ci = Ci->Next;+         ++Ci->Nb;+      }++      /* Keep the observed numbers in sstring_Count */+      for (j = jlow; j <= jhigh; j++)+         res->Count[j] = 0;+      Ci = XS;+      j = 1;+      while (Ci) {+         if (j >= res->jmax)+            res->Count[res->jmax] += Ci->Nb;+         else+            res->Count[Loca[j]] += Ci->Nb;+         Ci = Ci->Next;+         ++j;+      }++      X2 = gofs_Chi2 (res->NbExp, res->Count, jlow, jhigh);+      statcoll_AddObs (res->sVal1, X2);+      if (swrite_Counters)+         tables_WriteTabL (res->Count, jlow, jhigh, 5, 10,+                           "Observed population counts");+   }++   res->degFree = V[0] = NbGroups - 1;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+                      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);+   if (swrite_Basic) {+      swrite_AddStrChi (str, LEN1, NbGroups - 1);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   DeleteCorr (corr);+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static double ProbabiliteLHR (long j, double Lnl)+/*+ * Returns the probability that the longest series of successive 1 has+ * length = j.+ */+{+   double x, temp;+   temp = (j + 1) * num_Ln2 - Lnl;+   x = exp (-exp (-temp));+   temp += num_Ln2;+   x = exp (-exp (-temp)) - x;+   return x;+}+++/*-------------------------------------------------------------------------*/++static void WriteDataLongHead (unif01_Gen *gen, char *Test,+   long N, long n, int r, int s, long L)+{+   swrite_Head (gen, Test, N, n, r);+   printf (",   s = %1d,   L = %1ld\n\n", s, L);+}+++/*-------------------------------------------------------------------------*/++void sstring_LongestHeadRun (unif01_Gen *gen, sstring_Res2 *res,+   long N, long n, int r, int s, long L)+{+   const double eps = DBL_EPSILON;+   const long K = L/s;             /* Number of iterations */+   long Rep;                       /* Current replication number */+   long Seq;                       /* Current sequence number */+   long i;+   double LnLen;                   /* log (L) or log (NnL) */+   double X2, temp;+   int j;+   long longest;                   /* Longest serie of 1 in a block */+   long longest2;                  /* Longest serie of 1 over all blocks */+   long longest3;                  /* Longest serie of 1 over all Replic. */+   long longueur;                  /* Run length in a block */+   long longueur2;                 /* Run length in a sequence */+   long longueur3;                 /* Run length in a replication */+   long jhigh;                     /* Highest class for Chi2 */+   long jhigh2;                    /* Highest index for CDF[j] */+   long NbGroups;                  /* Number of classes for Chi2 */+   bitset_BitSet ensemble;         /* Chosen bits in each generated number */+   double V[1];                    /* Number degrees of freedom for Chi2 */+   char str [LEN1 + 1];+   double NbExp [DIM + 1];         /* Expected numbers */+   double CDF [DIM + 1];           /* Cumulative probabilities */+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sstring_LongestHeadRun test";+   sres_Chi2 *Chi;+   sres_Disc *Disc;++   Timer = chrono_Create ();+   L = K * s;+   if (swrite_Basic)+      WriteDataLongHead (gen, TestName, N, n, r, s, L);+   util_Assert (L >= LMIN, "sstring_LongestHeadRun:   L < 1000");+   if (res == NULL) {+      localRes = TRUE;+      res = sstring_CreateRes2 ();+   }+   jhigh = DIM;++   /* Get the expected numbers for the chi-square for blocks of L bits */+   LnLen = log ((double) L);+   CDF[0] = ProbabiliteLHR (0, LnLen);+   NbExp[0] = n * CDF[0];+   for (j = 1; j < DIM; j++) {+      temp = ProbabiliteLHR (j, LnLen);+      NbExp[j] = n * temp;+      CDF[j] = temp + CDF[j-1];+      if  ((temp <= eps) && (CDF[j] > 0.5)) {+         jhigh = j;+         break;+      }+   }+   util_Assert (jhigh > 0, "sstring_LongestHeadRun:   jhigh = 0");+   NbExp[jhigh] = n * (1.0 - CDF[jhigh - 1]);++   /* Get the probabilities for the global run over the N*n*L bits */+   LnLen = log (N * (double) n * (double) L);   /* Avoid overflow of long */+   CDF[0] = ProbabiliteLHR (0, LnLen);+   for (j = 1; j < DIM; j++) {+      temp = ProbabiliteLHR (j, LnLen);+      CDF[j] = temp + CDF[j-1];+      if ((temp <= eps) && (CDF[j] > 0.5)) {+         jhigh2 = j;+         break;+      }+   }++   InitRes2 (res, N, jhigh);+   Disc = res->Disc;+   Chi = res->Chi;+   tables_CopyTabD (NbExp, Chi->NbExp, 0, jhigh);++   if (swrite_Classes)+      gofs_WriteClasses (Chi->NbExp, Chi->Loc, 0, jhigh, 0);+   gofs_MergeClasses (Chi->NbExp, Chi->Loc, &Chi->jmin, &Chi->jmax, &NbGroups);+   if (swrite_Classes)+      gofs_WriteClasses (Chi->NbExp, Chi->Loc, Chi->jmin, Chi->jmax, NbGroups);+   Chi->degFree = NbGroups - 1;+   if (Chi->degFree <= 0) {+      util_Assert (1, "sstring_LongestHeadRun:   Chi->degFree = 0");+      if (localRes)+         sstring_DeleteRes2 (res);+      return;+   }++   sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"+                 " of freedom):", Chi->degFree);+   statcoll_SetDesc (Chi->sVal1, str);+   statcoll_SetDesc (Disc->sVal1,+        "The longest run of 1 for each replication ");++   /* Beginning of test */+   longest3 = longueur3 = 0;+   for (Rep = 1; Rep <= N; Rep++) {+      for (i = Chi->jmin; i <= Chi->jmax; i++)+         Chi->Count[i] = 0;++      longest2 = -1;            /* -1 at the beginning of a new replication */+      longueur2 = 0;+      for (Seq = 1; Seq <= n; Seq++) {+	 longest = -1;            /* -1 at the beginning of a new sequence */+         longueur = 0;+         for (i = 1; i <= K; i++) {+            /* Now build a block of L bits */+            ensemble = unif01_StripB (gen, r, s);+            /* Examine each bit of a number */+            for (j = s - 1; j >= 0; j--) {+               if (bitset_TestBit (ensemble, j))+                  ++longueur;+               else {+		  /* Beginning of a sequence: merge last block of 1's of   */+		  /* last sequence with first block of 1's of new sequence */+		  if (longest < 0) {+		     /* Beginning of a replication: merge last sequence of */+		     /* 1's of last replication with first sequence of 1's */+		     /* of new replication */+                     if (longest2 < 0) {+                        longueur3 += longueur;+                        if (longueur3 > longest3)+                           longest3 = longueur3;+		     }+                     longueur2 += longueur;+                     if (longueur2 > longest2)+                        longest2 = longueur2;+		  }+                  if (longueur > longest)+                     longest = longueur;+                  longueur = 0;+               }+            }+         }+         if (longueur > longest)+            longest = longueur;+         if (longest >= Chi->jmax)+            ++Chi->Count[Chi->jmax];+         else if (longest <= Chi->jmin)+            ++Chi->Count[Chi->jmin];+         else+            ++Chi->Count[Chi->Loc[longest]];+         if (longest > longest2)+            longest2 = longest;+         longueur3 = longueur2 = longueur;+      }++      X2 = gofs_Chi2 (Chi->NbExp, Chi->Count, Chi->jmin, Chi->jmax);+      statcoll_AddObs (Chi->sVal1, X2);+      statcoll_AddObs (Disc->sVal1, (double) longest2);+      if (longest2 > longest3)+	 longest3 = longest2;+      if (swrite_Counters)+         tables_WriteTabL (Chi->Count, Chi->jmin, Chi->jmax, 5, 10,+                           "Observed numbers");+      longueur = 0;+      for (j = Chi->jmin; j <= Chi->jmax; j++)+         longueur += Chi->Count[j];+      util_Warning (longueur != n, "Total Count != n");+   }+   Disc->sVal2 = longest3;+   if (longest3 > jhigh2) {+      Disc->pLeft = 1.0;+      Disc->pRight = 0.0;+   } else {+      Disc->pLeft = CDF[longest3];+      if (longest3 > 0)+         Disc->pRight = 1.0 - CDF[longest3 - 1];+      else+         Disc->pRight = 1.0;+   }+   Disc->pVal2 = gofw_pDisc (Disc->pLeft, Disc->pRight);++   V[0] = Chi->degFree;+   gofw_ActiveTests2 (Chi->sVal1->V, Chi->pVal1->V, N, wdist_ChiSquare, V,+      Chi->sVal2, Chi->pVal2);+   Chi->pVal1->NObs = N;+   sres_GetChi2SumStat (Chi);++   if (swrite_Collectors) {+      statcoll_Write (Chi->sVal1, 5, 14, 4, 3);+      statcoll_Write (Disc->sVal1, 5, 14, 0, 0);+   }+   if (swrite_Basic) {+      swrite_AddStrChi (str, LEN1, Chi->degFree);+      gofw_WriteActiveTests2 (N, Chi->sVal2, Chi->pVal2, str);+      swrite_Chi2SumTest (N, Chi);+      printf ("-----------------------------------------------\n");+      printf ("Global longest run of 1               :");+      gofw_Writep2 (Disc->sVal2, Disc->pVal2);+      printf ("\n\n");+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sstring_DeleteRes2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void HammingWeight2_L (unif01_Gen * gen, sres_Basic * res,+   long N, int r, int s, long L, long K)+/*+ * Generate all the n bits for the HammingWeight2 test in the case L > s. + * For the last number generated in a block of L bits, we keep its first+ * LMods bits and discard the other bits.+ */+{+   const int LDivs = L / s;         /* A block uses LDivs numbers ... */+   const int LMods = L % s;         /* + 1 if LMods > 0 */+   const double L2 = L / 2.0;+   int co, j;+   long i, Seq;+   unsigned long Z;+   double X2;++   for (Seq = 1; Seq <= N; Seq++) {+      X2 = 0.0;+      for (i = 0; i < K; i++) {+         /* Generate a block of L bits */+         co = 0;+         for (j = 0; j < LDivs; j++) {+            Z = unif01_StripB (gen, r, s);+            while (Z > 0) {               /* Count the number of 1 bits */+               Z &= Z - 1;                /* Clear lowest 1 bit */+               ++co;+            }+         }+         /* The last bits of the block */+         if (LMods > 0) {+            Z = unif01_StripB (gen, r, LMods);+            while (Z > 0) {+               Z &= Z - 1;+               ++co;+            }+         }+         X2 += (co - L2)*(co - L2);+      }+      X2 *= 4.0 / L;+      statcoll_AddObs (res->sVal1, X2);+   }+}+++/*-------------------------------------------------------------------------*/++static void HammingWeight2_S (unif01_Gen * gen, sres_Basic * res,+   long N, int r, int s, long L, long K)+/*+ * Generate all the n bits for the HammingWeight2 test in the case L <= s. + * A number generates sDivL blocks. If s % L == 0, we use all s bits of the+ * number.+ */+{+   const int sDivL = s / L;         /* A number generates sDivL blocks */+   const long Q = K / sDivL + (K % sDivL > 0);+   const unsigned long MASK = num_TwoExp[L] - 1.0;+   const double L2 = L / 2.0;+   int co, j;+   long i, Seq;+   unsigned long Z, Y;+   double X2;++   for (Seq = 1; Seq <= N; Seq++) {+      X2 = 0.0;+      for (i = 0; i < Q; i++) {+         Z = unif01_StripB (gen, r, s);++         /* Generate sDivL blocks of L bits */+         for (j = 0; j < sDivL; j++) {+            co = 0;+            Y = Z & MASK;+            while (Y > 0) {        /* Count the number of 1 bits */+               Y &= Y - 1;         /* Clear lowest 1 bit */+               ++co;+            }+            X2 += (co - L2)*(co - L2);+            Z >>= L;+         }+      }+      X2 *= 4.0 / L;+      statcoll_AddObs (res->sVal1, X2);+   }+}+++/*-------------------------------------------------------------------------*/++void sstring_HammingWeight2 (unif01_Gen * gen, sres_Basic * res,+   long N, long n, int r, int s, long L)+{+   const long K = n / L;+   double sum;+   double V[1];                   /* Number of Chi2 degrees of freedom */+   char chaine[LEN1 + 1] = "";+   char str[LEN2 + 1] = "";+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sstring_HammingWeight2 test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataLongHead (gen, TestName, N, n, r, s, L);+   util_Assert (r + s <= 32, "sstring_HammingWeight2:   r + s > 32");+   util_Assert (L <= n, "sstring_HammingWeight2:   L > n");+   util_Assert (L >= 2, "sstring_HammingWeight2:   L < 2");++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateBasic ();+   }+   sres_InitBasic (res, N, "sstring_HammingWeight2");+   strncpy (chaine, "sVal1:   a chi-square with ", (size_t) LEN1);+   sprintf (str, "%ld", K);+   strncat (chaine, str, (size_t) LEN2);+   strncat (chaine, " degrees of freedom", (size_t) LEN1);+   statcoll_SetDesc (res->sVal1, chaine);++   if (L >= s)+      HammingWeight2_L (gen, res, N, r, s, L, K);+   else+      HammingWeight2_S (gen, res, N, r, s, L, K);++   V[0] = K;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+                      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sum = N * statcoll_Average (res->sVal1);+   res->sVal2[gofw_Sum] = sum;+   res->pVal2[gofw_Sum] = fbar_ChiSquare2 (N*K, 12, sum);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 2, 1);+   if (swrite_Basic) {+      swrite_AddStrChi (str, LEN2, K);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTestb (N, res->sVal2[gofw_Sum], res->pVal2[gofw_Sum], K);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteBasic (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void HammingWeight_L (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, int s, long L)+/*+ * Generate all the n*L bits for the HammingWeight test in the case L > s. + * For the last number generated in a block of L bits, we keep its first+ * LMods bits and discard the other bits.+ */+{+   const int LDivs = L / s;         /* A block uses LDivs numbers ... */+   const int LMods = L % s;         /* + 1 if LMods > 0 */+   int co, j;+   long i, Seq;+   unsigned long Z;+   double X2;++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = res->jmin; i <= res->jmax; i++)+         res->Count[i] = 0;++      for (i = 0; i < n; i++) {+         /* Generate a block of L bits */+         co = 0;+         for (j = 0; j < LDivs; j++) {+            Z = unif01_StripB (gen, r, s);+            while (Z > 0) {               /* Count the number of 1 bits */+               Z &= Z - 1;                /* Clear lowest 1 bit */+               ++co;+            }+         }+         /* The last bits of the block */+         if (LMods > 0) {+            Z = unif01_StripB (gen, r, LMods);+            while (Z > 0) {+               Z &= Z - 1;+               ++co;+            }+         }+         ++res->Count[res->Loc[co]];+      }++      X2 = gofs_Chi2 (res->NbExp, res->Count, res->jmin, res->jmax);+      statcoll_AddObs (res->sVal1, X2);+      if (swrite_Counters)+         tables_WriteTabL (res->Count, res->jmin, res->jmax, 5, 10,+                           "Observed numbers of blocks");+   }+}+++/*-------------------------------------------------------------------------*/++static void HammingWeight_S (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, int s, long L)+/*+ * Generate all the n*L bits for the HammingWeight test in the case L <= s. + * A number generates sDivL blocks. If s % L == 0, we use all s bits of the+ * number.+ */+{+   const int sDivL = s / L;         /* A number generates sDivL blocks */+   const int s1 = s - s % L;+   const long Q = n / sDivL;+   const int Q2 = n % sDivL;+   const unsigned long MASK = num_TwoExp[L] - 1.0;+   int co, j;+   long i, Seq;+   unsigned long Z, Y;+   double X2;++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = res->jmin; i <= res->jmax; i++)+         res->Count[i] = 0;++      for (i = 0; i < Q; i++) {+         Z = unif01_StripB (gen, r, s1);++         /* Generate sDivL blocks of L bits */+         for (j = 0; j < sDivL; j++) {+            co = 0;+            Y = Z & MASK;+            while (Y > 0) {        /* Count the number of 1 bits */+               Y &= Y - 1;         /* Clear lowest 1 bit */+               ++co;+            }+            ++res->Count[res->Loc[co]];+            Z >>= L;+         }+      }++      /* The last bits */+      if (Q2 > 0) {+	 Z = unif01_StripB (gen, r, Q2 * L);+         for (j = 0; j < Q2; j++) {+            co = 0;+            Y = Z & MASK;+            while (Y > 0) {        /* Count the number of 1 bits */+               Y &= Y - 1;         /* Clear lowest 1 bit */+               ++co;+            }+            ++res->Count[res->Loc[co]];+            Z >>= L;+         }+      }++      X2 = gofs_Chi2 (res->NbExp, res->Count, res->jmin, res->jmax);+      statcoll_AddObs (res->sVal1, X2);+      if (swrite_Counters)+         tables_WriteTabL (res->Count, res->jmin, res->jmax, 5, 10,+                           "Observed numbers of blocks");+   }+}+++/*-------------------------------------------------------------------------*/++void sstring_HammingWeight (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, int s, long L)+{+   long i;+   double V[1];                   /* Number of Chi2 degrees of freedom */+   char str[LEN1 + 1] = "";+   fmass_INFO Q;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   long jlow, jhigh;+   long NbGroups;                 /* Number of classes */+   char *TestName = "sstring_HammingWeight test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataLongHead (gen, TestName, N, n, r, s, L);+   util_Assert (r + s <= 32, "sstring_HammingWeight:   r + s > 32");+   util_Assert (L >= 2, "sstring_HammingWeight:   L < 2");++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, L, "sstring_HammingWeight");++   Q = fmass_CreateBinomial (L, 0.5, 0.5);+   for (i = 0; i <= L; i++)+      res->NbExp[i] = n * fmass_BinomialTerm2 (Q, i);+   fmass_DeleteBinomial (Q);++   jlow = 0;+   jhigh = L;+   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, res->Loc, jlow, jhigh, 0);+   gofs_MergeClasses (res->NbExp, res->Loc, &jlow, &jhigh, &NbGroups);+   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, res->Loc, jlow, jhigh, NbGroups);+   res->jmin = jlow;+   res->jmax = jhigh;+   res->degFree = NbGroups - 1;+   if (res->degFree < 1) {+      if (localRes)+         sres_DeleteChi2 (res);+      return;+   }+   sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"+                 " of freedom):", NbGroups - 1);+   statcoll_SetDesc (res->sVal1, str);++   if (L >= s)+      HammingWeight_L (gen, res, N, n, r, s, L);+   else+      HammingWeight_S (gen, res, N, n, r, s, L);++   V[0] =  res->degFree;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+                      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 2, 1);+   if (swrite_Basic) {+      swrite_AddStrChi (str, LEN1, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++#if 0+void sstring_Run0 (unif01_Gen * gen, sres_Basic * res,+   long N, long n, int r, int s)+{+   const long K = n / s;          /* If n % s != 0, a string will contain +                                     K * s bits instead of n */+   const unsigned long SBIT = 1UL << (s - 1);+   unsigned long jBit;            /* Position of current bit in Z */+   int pBit;                      /* Previous bit */+   long i, Seq;+   long co1;                      /* Counter for number of 1 */+   long cor;                      /* Counter for number of runs */+   unsigned long Z;+   double X, f1;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sstring_Run test";++   Timer = chrono_Create ();+   n = K * s;+   if (swrite_Basic)+      WriteDataPeriod (gen, TestName, N, n, r, s);++   util_Assert (r + s <= 32, "sstring_Run:   r + s > 32");+   /*   util_Assert (100 <= n, "sstring_Run:   n < 100"); */++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateBasic ();+   }+   sres_InitBasic (res, N, "sstring_Run");+   statcoll_SetDesc (res->sVal1, "sVal1:   a standard normal");++   for (Seq = 1; Seq <= N; Seq++) {+      co1 = cor = 0;+      /* Be sure to count the first run with pBit != {0, 1} */+      pBit = 2;+      for (i = 0; i < K; i++) {+         Z = unif01_StripB (gen, r, s);+         jBit = SBIT;++         /* Add the number of 1 bit and number of runs in Z */+         while (jBit > 0) {+	    if (Z & jBit) {                /* bit 1 */+               co1++;+               if (pBit != 1)+                  cor++;+               pBit = 1;+            } else {                       /* bit 0 */+               if (pBit != 0)+                  cor++;+               pBit = 0;+            }+            jBit >>= 1;+         }+      }+      f1 = (double) co1 / (K * s);+      X = (cor - n * 2.0 * f1 * (1.0 - f1)) /+          (2.0 * sqrt ((double) n) * f1 * (1.0 - f1));+      statcoll_AddObs (res->sVal1, X);+   }+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Normal,+       (double *) NULL, res->sVal2, res->pVal2);+   res->pVal1->NObs = N;++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,+         "Normal statistic                      :");+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteBasic(res);+   chrono_Delete (Timer);+}+#endif+++/*=========================================================================*/++void sstring_Run (unif01_Gen * gen, sstring_Res3 *res,+   long N, long n, int r, int s)+{+   const unsigned long SBIT = 1UL << (s - 1);+   const double sr = s;+   unsigned long jBit;            /* Position of current bit in Z */+   int pBit;                      /* Previous bit */+   int k, j;+   long Seq;+   double cob;                    /* Counter for number of bits */+   long cor;                      /* Counter for number of 1 runs */+   int len;                       /* Length of current run */+   unsigned long Z;+   double X2, X, temp;+   char str[LEN1 + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sstring_Run test";+   sres_Basic *NBits;+   sres_Chi2 *NRuns;+   long *Count0,  *Count1;+   double *Prob, *NbExp;+   double Param[1];++   Timer = chrono_Create ();+   k = 1 + num_Log2 (n / gofs_MinExpected);+   if (swrite_Basic)+      WriteDataPeriod (gen, TestName, N, n, r, s);+   util_Assert (r + s <= 32, "sstring_Run:   r + s > 32");+   /*   util_Assert (100 <= n, "sstring_Run:   n < 100"); */++   if (res == NULL) {+      localRes = TRUE;+      res = sstring_CreateRes3 ();+   }+   InitRes3 (res, N, k);+   NBits = res->NBits;+   NRuns = res->NRuns;+   Count0 = res->Count0;+   Count1 = res->Count1;++   statcoll_SetDesc (NBits->sVal1,+       "The N statistic values (a standard normal):");+   sprintf (str, "The N statistic values (a ChiSquare with %1d degrees"+                 " of freedom):", 2*(k - 1));+   statcoll_SetDesc (NRuns->sVal1, str);++   Prob = util_Calloc (1 + (size_t) k, sizeof (double));+   Prob[0] = 1.0;+   for (j = 1; j < k; j++) {+      Prob[j] = Prob[j - 1] / 2.0; +      NRuns->NbExp[j] = n * Prob[j];+   }+   Prob[k] = Prob[k - 1]; +   NRuns->NbExp[k] = n * Prob[k];+   util_Assert (NRuns->NbExp[k] >= gofs_MinExpected,+        "sstring_Run:   NRuns->NbExp[k] < gofs_MinExpected");++   if (swrite_Classes)+      gofs_WriteClasses (NRuns->NbExp, NRuns->Loc, 1, k, 0);+   NRuns->jmax = k;+   NRuns->jmin = 1;+   NRuns->degFree = 2*(k - 1);+   if (NRuns->degFree < 1) {+      util_Warning (TRUE, "Chi-square with 0 degree of freedom.");+      if (localRes)+         sstring_DeleteRes3 (res);+      return;+   }++   for (Seq = 1; Seq <= N; Seq++) {+      cob = cor = len = 0;+      for (j = 1; j <= k; j++) {+	 Count0[j] = 0;+	 Count1[j] = 0;+      }++      /* Make sure to count the first run; set pBit != {0, 1} */+      pBit = 2;+      while (cor < n) {+         Z = unif01_StripB (gen, r, s);+         jBit = SBIT;+         cob += sr;+         if (len >= n) {+	    util_Warning (TRUE, "sstring_Run:   all bits are 0 !");+            util_Free (Prob);+            if (localRes)+               sstring_DeleteRes3 (res);+            return;+	 }++         /* Add the number of runs in Z */+         while (jBit > 0) {+	    if (Z & jBit) {                /* bit 1 */+	       if (pBit != 1) {+                  cor++;+                  if (len < k)+		     (Count0[len])++;+                  else+		     (Count0[k])++;+                  len = 1;+	       } else {+		 len++;+	       }+               pBit = 1;+            } else {                       /* bit 0 */+	       if (pBit != 0) {+                  if (len < k)+		     (Count1[len])++;+                  else+		     (Count1[k])++;+                  len = 1;+	       } else {+		 len++;+	       }+               pBit = 0;+            }+            jBit >>= 1;+         }+      }++      X2 = 0.0;+      NbExp = NRuns->NbExp;+      for (j = NRuns->jmin; j <= NRuns->jmax; j++) {+	 temp = Count0[j] - NbExp[j];+         X2 += temp * temp / (NbExp[j] * (1.0 - Prob[j]));+      }+      X = X2;+      X2 = 0.0;+      for (j = NRuns->jmin; j <= NRuns->jmax; j++) {+	 temp = Count1[j] - NbExp[j];+         X2 += temp * temp / (NbExp[j] * (1.0 - Prob[j]));+      }+      statcoll_AddObs (NRuns->sVal1, X2 + X);++      if (swrite_Counters) {+         tables_WriteTabL (Count0, 1, k, 5, 10,+             "Observed number of runs of 0");+         tables_WriteTabL (Count1, 1, k, 5, 10,+             "Observed number of runs of 1");+      }++      X = (cob - 4.0 * n) / sqrt (8.0 * n);+      statcoll_AddObs (NBits->sVal1, X);+   }++   Param[0] = 2*(k - 1);+   gofw_ActiveTests2 (NRuns->sVal1->V, NRuns->pVal1->V, N, wdist_ChiSquare,+      Param, NRuns->sVal2, NRuns->pVal2);+   NRuns->pVal1->NObs = N;+   sres_GetChi2SumStat (NRuns);++   gofw_ActiveTests2 (NBits->sVal1->V, NBits->pVal1->V, N, wdist_Normal,+       (double *) NULL, NBits->sVal2, NBits->pVal2);+   NBits->pVal1->NObs = N;+   sres_GetNormalSumStat (NBits);+++   if (swrite_Basic) {+      printf ("\n-----------------------------------------------\n");+      if (N == 1) {+         printf ("Total number of 1 runs:  %1ld\n\n", cor);+         printf ("Number of degrees of freedom          : %4ld\n",+                 NRuns->degFree);+         printf ("Chi2 statistic for number of runs     :");+         gofw_Writep2 (NRuns->sVal2[gofw_Mean], NRuns->pVal2[gofw_Mean]);+      } else {+         printf ("Test results for the number of runs:\n");+         gofw_WriteActiveTests0 (N, NRuns->sVal2, NRuns->pVal2);+         swrite_Chi2SumTest (N, NRuns);+      }+      if (swrite_Collectors)+         statcoll_Write (NRuns->sVal1, 5, 14, 4, 3);++      printf ("\n-----------------------------------------------\n");+      if (N == 1) {+         printf ("Total number of bits:  %.0f\n\n", cob);+         printf ("Normal statistic for number of bits   :");+         gofw_Writep2 (NBits->sVal2[gofw_Mean], NBits->pVal2[gofw_Mean]);+      } else {+         printf ("Test results for the number of bits:\n");+         gofw_WriteActiveTests0 (N, NBits->sVal2, NBits->pVal2);+         swrite_NormalSumTest (N, NBits);+      }+      if (swrite_Collectors)+         statcoll_Write (NBits->sVal1, 5, 14, 4, 3);++      printf ("\n\n");+      swrite_Final (gen, Timer);+   }+   util_Free (Prob);+   if (localRes)+      sstring_DeleteRes3 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataAutoCor (unif01_Gen *gen, char *Test,+   long N, long n, int r, int s, int d)+{+   swrite_Head (gen, Test, N, n, r);+   printf (",   s = %1d,   d = %1d\n\n", s, d);+}+++/*-------------------------------------------------------------------------*/++void sstring_AutoCor (unif01_Gen * gen, sres_Basic * res,+   long N, long n, int r, int s, int d)+{+   const long K = (n - d) / s;+   const long M = d / s + 2;+   unsigned long *Y;              /* Circular buffer for random numbers */+   unsigned long A;               /* Correlation */+   unsigned long Z, s1, s2;+   unsigned long mask1, mask2;    /* Masks of s1, s2 least sig. bits */+   double X;+   long i, Seq;+   int j1, j2;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sstring_AutoCor test";++   Timer = chrono_Create ();+   /* There are a few bits less than n */+   n -= (n - d) % s;+   if (swrite_Basic)+      WriteDataAutoCor (gen, TestName, N, n, r, s, d);++   util_Assert (r + s <= 32, "sstring_AutoCor:   r + s > 32");+   util_Assert (d <= n / 2, "sstring_AutoCor:   d > n/2");+   util_Assert (d > 0, "sstring_AutoCor:   d < 1");++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateBasic ();+   }+   sres_InitBasic (res, N, "sstring_AutoCor");+   Y = util_Calloc ((size_t) M, sizeof (unsigned long));+   statcoll_SetDesc (res->sVal1, "sVal1:   a standard normal");+   s1 = d % s;+   s2 = s - s1;+   mask1 = num_TwoExp[s1] - 1.0;+   mask2 = num_TwoExp[s2] - 1.0;++   for (Seq = 1; Seq <= N; Seq++) {+      /* Fill circular buffer with first random numbers */+      for (i = 0; i < M-1; i++)+         Y[i] = unif01_StripB (gen, r, s);++      A = 0;+      j1 = M - 1;+      j2 = M - 2;+      for (i = 0; i < K; i++) {+         Y[j1] = unif01_StripB (gen, r, s);+         j1 = (j1 + 1) % M;+         Z = ((Y[j1] >> s1) ^ Y[j2]) & mask2;+         while (Z > 0) {          /* Count the number of 1 bits in Z */+            Z &= Z - 1;           /* Clear lowest 1 bit */+            ++A;+         }+         j2 = (j2 + 1) % M;++         Z = ((Y[j2] >> s2) ^ Y[j1]) & mask1;+         while (Z > 0) {+            Z &= Z - 1;+            ++A;+         }+      }++      X = 2.0 * (A - (n - d) / 2.0) / sqrt ((double) (n - d));+      statcoll_AddObs (res->sVal1, X);+   }++   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Normal,+      (double *) NULL, res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetNormalSumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,+         "Normal statistic                      :");+      swrite_NormalSumTest (N, res);+      swrite_Final (gen, Timer);+   }+   util_Free (Y);+   if (localRes)+      sres_DeleteBasic (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataHammingCorr (unif01_Gen *gen, char *TestName,+   long N, long n, int r, int s, int L)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   s = %1d,   L = %1d\n\n\n", s, L);+}+++/*-------------------------------------------------------------------------*/++static void HammingCorr_L (unif01_Gen *gen, sstring_Res * res,+   long n, int r, int s, int L)+/*+ * Generate all the n bits for the HammingCorr test in the case L > s. + * For the last number generated in a block of L bits, we keep its first+ * LMods bits and discard the other bits.+ */+{+   const int LMods = L % s;+   const int LDivs = L / s;+   int Pre, X;+   int j;+   long k;+   unsigned long Z;++   /* Junk value to avoid a test "if (k == 1)" for every generated+      number; it will not be counted. */+   Pre = L + 1;+   for (k = 1; k <= n; k++) {+      /* Generate a sequence of L bits */+      X = 0;+      for (j = 1; j <= LDivs; j++) {+	 Z = unif01_StripB (gen, r, s);+	 /* Count the number of 1 bits */+	 while (Z > 0) {+	    Z &= Z - 1;                /* Clear lowest 1 bit */+	    ++X;+	 }+      }+      /* The last bits of the sequence */+      if (LMods > 0) {+	 Z = unif01_StripB (gen, r, LMods);+	 while (Z > 0) {+	    Z &= Z - 1;+	    ++X;+	 }+      }+      ++res->Counters[Pre][X];+      Pre = X;+   }+}+++/*-------------------------------------------------------------------------*/++static void HammingCorr_S (unif01_Gen *gen, sstring_Res * res,+   long n, int r, int s, int L)+/*+ * Generate all the n bits for the HammingCorr test in the case L <= s. + * A number generates sDivL blocks. If s % L == 0, we use all s bits of the+ * number.+ */+{+   const int sDivL = s / L;         /* A number generates sDivL blocks */+   const long Q = n / sDivL;+   const long Q1 = n % sDivL;+   const unsigned long MASK = num_TwoExp[L] - 1.0;+   int Pre, X;+   int j;+   long k;+   unsigned long Z, Y;++   /* Junk value to avoid a test "if (k == 1)" for every generated+      number; it will not be counted. */+   Pre = L + 1;+   for (k = 0; k < Q; k++) {+      Z = unif01_StripB (gen, r, s);++      for (j = 0; j < sDivL; j++) {+	 X = 0;+	 Y = Z & MASK;+	 while (Y > 0) {        /* Count the number of 1 bits */+	    Y &= Y - 1;         /* Clear lowest 1 bit */+	    ++X;+	 }+         ++res->Counters[Pre][X];+         Pre = X;+	 Z >>= L;+      }+   }++   /* The last Q1 blocks */+   if (Q1 > 0) {+      Z = unif01_StripB (gen, r, s);+      for (j = 0; j < Q1; j++) {+	 X = 0;+	 Y = Z & MASK;+	 while (Y > 0) {        /* Count the number of 1 bits */+	    Y &= Y - 1;         /* Clear lowest 1 bit */+	    ++X;+	 }+	 ++res->Counters[Pre][X];+	 Pre = X;+	 Z >>= L;+      }+   }+}+++/*-------------------------------------------------------------------------*/++void sstring_HammingCorr (unif01_Gen * gen, sstring_Res * res,+   long N, long n, int r, int s, int L)+{+   int i, j;+   long Seq;+   double Sum;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sstring_HammingCorr test";++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataHammingCorr (gen, TestName, N, n, r, s, L);++   util_Assert (s <= num_MaxTwoExp, "sstring_HammingCorr:   s too large");+   util_Assert ((unsigned) s <= CHAR_BIT * sizeof (unsigned long),+                "sstring_HammingCorr:   s too large");++   if (res == NULL) {+      localRes = TRUE;+      res = sstring_CreateRes ();+   }+   InitRes (res, N, L, -1, "sstring_HammingCorr");+   statcoll_SetDesc (res->Bas->sVal1, "HammingCorr sVal1:   standard normal");++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = 0; i <= L; i++) {+         for (j = 0; j <= L; j++)+            res->Counters[i][j] = 0;+      }+      if (L >= s)+	 HammingCorr_L (gen, res, n, r, s, L);+      else+	 HammingCorr_S (gen, res, n, r, s, L);++      if (swrite_Counters)+         /* Print the matrix of counters */+         tables_WriteMatrixL (res->Counters, 0, L, 0, L, 8,+                              res->Style, "Number of pairs [0..L, 0..L]");++      /* Calculate statistic */+      Sum = 0.0;+      for (i = 0; i <= L; i++) {+         for (j = 0; j <= L; j++)+            Sum += res->Counters[i][j] * (i - L / 2.0) * (j - L / 2.0);+      }+      Sum = Sum * 4.0 / (L * sqrt (n - 1.0));+      statcoll_AddObs (res->Bas->sVal1, Sum);+   }++   gofw_ActiveTests2 (res->Bas->sVal1->V, res->Bas->pVal1->V, N,+      wdist_Normal, (double *) NULL, res->Bas->sVal2, res->Bas->pVal2);+   res->Bas->pVal1->NObs = N;+   sres_GetNormalSumStat (res->Bas);++   if (swrite_Collectors)+      statcoll_Write (res->Bas->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (N, res->Bas->sVal2, res->Bas->pVal2,+         "Normal statistic                      :");+      swrite_NormalSumTest (N, res->Bas);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sstring_DeleteRes (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataHammingIndep (unif01_Gen * gen, char *TestName,+   long N, long n, int r, int s, int L, int d)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   s = %1d,   L = %1d,   d = %1d\n\n\n", s, L, d);+}+++/*-------------------------------------------------------------------------*/++static void HammingIndep_L (unif01_Gen *gen, sstring_Res * res,+   long n, int r, int s, int L)+/*+ * Generate all the n bits for the HammingIndep test in the case L > s. + * For the last number generated in a block of L bits, we keep its first+ * LMods bits and discard the other bits.+ */+{+   int Pre;                         /* Previous value of X */+   int X;+   const int LMods = L % s;+   const int LDivs = L / s;+   int j;+   unsigned long U;+   unsigned long TwonUL;+   unsigned long ic;++   /* For the test with n >= 2^30 */+   TwonUL = 2 * (unsigned long) n;++   Pre = 0;                        /* Eliminate a warning from compiler */+   for (ic = 1; ic <= TwonUL; ic++) {+      /* Generate 1 block of L bits */+      X = 0;+      for (j = 1; j <= LDivs; j++) {+	 U = unif01_StripB (gen, r, s);+	 /* Count the number of 1 bits */+	 while (U > 0) {+	    U &= U - 1;        /* Clear lowest 1 bit */+	    ++X;+	 }+      }+      /* The last bits of the block */+      if (LMods > 0) {+	 U = unif01_StripB (gen, r, LMods);+	 while (U > 0) {+	    U &= U - 1;+	    ++X;+	 }+      }+      /* Non-overlapping pairs; count only when ic % 2 == 0 */+      if (!(ic & 1))+	 ++res->Counters[Pre][X];+      Pre = X;+   }+}+++/*-------------------------------------------------------------------------*/++static void HammingIndep_S (unif01_Gen *gen, sstring_Res * res,+   long n, int r, int s, int L)+/*+ * Generate all the n bits for the HammingIndep test in the case L <= s. + * A number generates sDivL blocks. If s % L == 0, we use all s bits of the+ * number.+ */+{+   const int sDivL = s / L;         /* A number generates sDivL blocks */+   const unsigned long MASK = num_TwoExp[L] - 1.0;+   int Pre;                         /* Previous value of X */+   int X;+   int j;+   unsigned long Q, Q1, i;+   unsigned long Z, Y;+   unsigned long TwonUL;+   unsigned long bloc = 0;++   /* For the test with n >= 2^30 */+   TwonUL = 2 * (unsigned long) n;+   Q = TwonUL / sDivL;+   Q1 = TwonUL % sDivL;++   Pre = 0;                     /* Eliminate a warning from compiler */+   for (i = 0; i < Q; i++) {+      Z = unif01_StripB (gen, r, s);++      for (j = 0; j < sDivL; j++) {+	 X = 0;+	 Y = Z & MASK;+	 while (Y > 0) {        /* Count the number of 1 bits */+	    Y &= Y - 1;         /* Clear lowest 1 bit */+	    ++X;+	 }+         /* Non-overlapping pairs; count only when bloc % 2 == 0 */+	 if (!(++bloc & 1))+	    ++res->Counters[Pre][X];+         Pre = X;+	 Z >>= L;+      }+   }++   /* The last Q1 blocks */+   if (Q1 > 0)+      Z = unif01_StripB (gen, r, s);+   for (i = 0; i < Q1; i++) {+      X = 0;+      Y = Z & MASK;+      while (Y > 0) {        /* Count the number of 1 bits */+	 Y &= Y - 1;         /* Clear lowest 1 bit */+	 ++X;+      }+      if (!(++bloc & 1))+         ++res->Counters[Pre][X];+      Pre = X;+      Z >>= L;+   }+}+++/*-------------------------------------------------------------------------*/++static void CountBlocks (+   sstring_Res *res,+   int L,                     /* Length of blocks (num bits) */+   int d                      /* Rank of rows-columns counted */++)+/*+ * Add the diagonal blocks for the matrix res->Counters, i.e. count the+ * number of values in the 4 corners of the matrix with the center removed.+ * We count only rows-columns of rank >= d starting from the center of+ * the matrix. We eliminate 2d - 1 rows and columns at the center of the+ * matrix when L is even. When L is odd, we eliminate 2d - 2 rows and+ * columns at the center (except when d = 1, where we keep all the rows+ * and columns).+ */+{+   int L2, L1, k, j, i;++   L2 = L1 = L / 2;+   if ((L & 1))+      ++L1;++   for (k = 1; k <= d; k++) {+      res->XD[k][0] = 0;+      res->XD[k][1] = 0;++      /* Block ++ */+      for (i = 0; i <= L1 - k; i++) {+         for (j = 0; j <= L1 - k; j++) {+            res->XD[k][0] += res->Counters[i][j];+         }+      }+      /* Block -- */+      for (i = L2 + k; i <= L; i++) {+         for (j = L2 + k; j <= L; j++) {+            res->XD[k][0] += res->Counters[i][j];+         }+      }+      /* Block +- */+      for (i = 0; i <= L1 - k; i++) {+         for (j = L2 + k; j <= L; j++) {+            res->XD[k][1] += res->Counters[i][j];+         }+      }+      /* Block -+ */+      for (i = L2 + k; i <= L; i++) {+         for (j = 0; j <= L1 - k; j++) {+            res->XD[k][1] += res->Counters[i][j];+         }+      }+   }+}++/*-------------------------------------------------------------------------*/++static void WriteBlocs (+   sstring_Res *res,+   int d                 /* Rank of rows-columns */+   )+/* + * Print the sum of counters in the diagonal blocks for different d+ */+{+   int i;+   printf ("--------------------------------------------------\n");++   for (i = 1; i <= d; i++) {+      printf ("The number of blocks ++, -- with d >= %1d is %10ld\n",+              i, res->XD[i][0]);+      printf ("The number of blocks +-, -+ with d >= %1d is %10ld\n\n",+              i, res->XD[i][1]);+   }+   printf ("\n");+}++/*-------------------------------------------------------------------------*/++void sstring_HammingIndep (unif01_Gen * gen, sstring_Res * res,+   long N, long n, int r, int s, int L, int d)+{+   int Liber = 0;           /* Num of degrees of freedom for main test */+   int Liberte;             /* Num of degrees of freedom for block tests */+   int X;+   int i, j;+   long Seq;+   double NbEsp;+   double Var;+   double NbMoyen;+   double X2;+   double Sum;+   const double nLR = n;+   double Z;+   double *Prob;+   double *NbEsp5;+   long *Count5;+   double V[1];+   fmass_INFO Q;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "sstring_HammingIndep test";+   char chaine[LEN1 + 1] = "";+   char str[LEN2 + 1];++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataHammingIndep (gen, TestName, N, n, r, s, L, d);++   if (n < 2.0 * gofs_MinExpected) {+      util_Warning (TRUE, "sstring_HammingIndep:   n < 20");+      return;+   }+   /*  util_Assert (n >= 30, "sstring_HammingIndep:   n < 30"); */+   util_Assert (d <= sstring_MAXD, "sstring_HammingIndep:   d > sstring_MAXD");+   util_Assert (((L + 1) / 2) >= d, "sstring_HammingIndep:   d > (L + 1) / 2");+   util_Assert (s <= num_MaxTwoExp, "sstring_HammingIndep:   s too large");+   util_Assert ((unsigned) s <= CHAR_BIT * sizeof (unsigned long),+      "sstring_HammingIndep:   s too large");++   if (res == NULL) {+      localRes = TRUE;+      res = sstring_CreateRes ();+   }+   InitRes (res, N, L, d, "sstring_HammingIndep");++   for (i = 1; i <= d; i++) {+      strncpy (chaine, "HammingIndep Block[", (size_t) LEN1);+      sprintf (str, "%1d", i);+      strncat (chaine, str, (size_t) LEN2);+      strncat (chaine, "]", (size_t) 2);+      statcoll_SetDesc (res->Block[i]->sVal1, chaine);+   }+   strncpy (chaine, "\nCounters with expected numbers >= ", (size_t) LEN1);+   sprintf (str, "%g", gofs_MinExpected);+   strncat (chaine, str, (size_t) LEN2);+   statcoll_SetDesc (res->Bas->sVal1, chaine);++   Prob   = util_Calloc ((size_t) L + 1, sizeof (double));+   NbEsp5 = util_Calloc ((size_t) (L + 1)*(L + 1) + 1, sizeof (double));+   Count5 = util_Calloc ((size_t) (L + 1)*(L + 1) + 1, sizeof (long));++   Q = fmass_CreateBinomial (L, 0.5, 0.5);+   for (i = 0; i <= L; i++)+      Prob[i] = fmass_BinomialTerm2 (Q, i);+   fmass_DeleteBinomial (Q);++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = 0; i <= L; i++) {+         for (j = 0; j <= L; j++) {+            res->Counters[i][j] = 0;+         }+      }+      if (L >= s)+	 HammingIndep_L (gen, res, n, r, s, L);+      else+	 HammingIndep_S (gen, res, n, r, s, L);++      /* The cells for which the expected number >= gofs_MinExpected will */+      /* correspond to one class each. Merge all other cells such that    */+      /* their expected number is < gofs_MinExpected into 1 big class: Z  */+      /* will contain the sum of all their expected numbers, and the      */+      /* counter X will contain the sum of all their observed numbers. We */+      /* shall apply a chi-square test with Liber degrees of freedom. We  */+      /* have (Liber + 1) classes. */+      Liber = 0;+      Z = 0.0;+      X = 0;+      for (i = 0; i <= L; i++) {+         for (j = 0; j <= L; j++) {+            res->ZCounters[i][j] = nLR * Prob[i] * Prob[j];+            if (res->ZCounters[i][j] >= gofs_MinExpected) {+               NbEsp5[Liber] = res->ZCounters[i][j];+               Count5[Liber] = res->Counters[i][j];+               ++Liber;+            } else {+               Z += res->ZCounters[i][j];+               X += res->Counters[i][j];+            }+         }+      }+      if (Z >= gofs_MinExpected) {+	/* We have one more class */+	/*  if (swrite_Classes && Seq == 1) {+            printf ("All cells with NbExp < ");+            printf ("%s", str);+            printf (" are merged into one big class with NbExp = %f\n\n", Z);+         } */+         NbEsp5[Liber] = Z;+         Count5[Liber] = X;+      } else if (Liber > 0) {+         /* We add them to the last class instead */+         --Liber;+         NbEsp5[Liber] += Z;+         Count5[Liber] += X;+      }++      /* Everything has been put in a single class; separate all in two+         classes */+      if (Liber == 0) {+	 Z = 0.0;+	 X = 0;+	 for (i = 0; i <= L; i++) {+	    for (j = 0; j <= L / 2; j++) {+	       res->ZCounters[i][j] = nLR * Prob[i] * Prob[j];+	       Z += res->ZCounters[i][j];+	       X += res->Counters[i][j];+	    }+	 }+         NbEsp5[0] = Z;+         Count5[0] = X;+	 Z = 0.0;+	 X = 0;+	 for (i = 0; i <= L; i++) {+	    for (j = 1 + L / 2; j <= L; j++) {+	       res->ZCounters[i][j] = nLR * Prob[i] * Prob[j];+	       Z += res->ZCounters[i][j];+	       X += res->Counters[i][j];+	    }+	 }+         NbEsp5[1] = Z;+         Count5[1] = X;+	 Liber = 1;+      }+      if (Liber > 0) {+         X2 = gofs_Chi2 (NbEsp5, Count5, 0, Liber);+         statcoll_AddObs (res->Bas->sVal1, X2);+      }++      /* Compute the normalized observed number for each pair */+      for (i = 0; i <= L; i++) {+         for (j = 0; j <= L; j++) {+            NbEsp = nLR * Prob[i] * Prob[j];+            Var = NbEsp * (1.0 - Prob[i] * Prob[j]);+            if (Var <= 0.0) {+               /* This case will occur when NbEsp = 0; if so, fail the test */+               /* when res->Counters[i][j] != 0 */+               res->ZCounters[i][j] = (res->Counters[i][j] - NbEsp) * 1.E100;+            } else {+               res->ZCounters[i][j] = (res->Counters[i][j] - NbEsp) /+                  sqrt (Var);+            }+         }+      }+      if (sstring_Counters)+         /* Print the matrix of counters */+         tables_WriteMatrixL (res->Counters, 0, L, 0, L, 8, res->Style,+            "res->Counters, the number of pairs [0..L, 0..L]");+      if (swrite_Counters)+         /* Print the matrix of normalized counters */+         tables_WriteMatrixD (res->ZCounters, 0, L, 0, L, 12, 4,+            res->Style, "res->ZCounters, the normalized counters");++      /* These blocks are sub-matrices symmetrically placed with respect to */+      /* the diagonals in the matrix of the number of pairs [Xi, X(i+1)]. */+      /* For those, we shall apply a chi-square test for the total number */+      /* in the diagonal sub-matrices. */+      CountBlocks (res, L, d);++      if (swrite_Counters)+         WriteBlocs (res, d);++      for (i = 1; i <= d; i++) {+         double NumExp[3];+         long Count[3];+         Sum = 0.0;+         for (j = 0; j <= (L + 1) / 2 - i; j++)+            Sum += Prob[j];+         /* Probability of a sub-matrix block */+         Sum *= Sum;+         /* Average number for each of the 2 blocks */+         NbMoyen = Sum * nLR * 2.0;+         NumExp[0] = NumExp[1] = NbMoyen;+         if (2.0*NbMoyen < gofs_MinExpected)+              printf ("******* sample too small for chi-square for d = %d\n", i);+         NumExp[2] = nLR - 2.0*NbMoyen;+         Count[0] = res->XD[i][0];+         Count[1] = res->XD[i][1];+         Count[2] = n - Count[0] - Count[1];+         X2 = gofs_Chi2 (NumExp, Count, 0, 2);+         statcoll_AddObs (res->Block[i]->sVal1, X2);+      }+   }++   for (i = 1; i <= d; i++) {+      /* Degrees of freedom */+      if ((L & 1) && i == 1)+         Liberte = 1;+      else+         Liberte = 2;++      V[0] = Liberte;+      gofw_ActiveTests2 (res->Block[i]->sVal1->V, res->Block[i]->pVal1->V, N,+         wdist_ChiSquare, V, res->Block[i]->sVal2, res->Block[i]->pVal2);+      res->Block[i]->pVal1->NObs = N;+      Sum = N * statcoll_Average (res->Block[i]->sVal1);+      res->Block[i]->sVal2[gofw_Sum] = Sum;+      res->Block[i]->pVal2[gofw_Sum] = fbar_ChiSquare2 (N*Liberte, 12, Sum);++      if (swrite_Basic) {+         printf ("\nDiagonal blocks with d = %2d", i);+         swrite_AddStrChi (str, LEN2, Liberte);+         gofw_WriteActiveTests2 (N, res->Block[i]->sVal2,+                                 res->Block[i]->pVal2, str);+         swrite_Chi2SumTestb (N, res->Block[i]->sVal2[gofw_Sum],+                                 res->Block[i]->pVal2[gofw_Sum], Liberte);+         if (swrite_Collectors) {+            strncpy (chaine, res->Block[i]->sVal1->Desc, (size_t) LEN1);+            strncat (chaine, ":   a chi2 with ", (size_t) LEN1);+            sprintf (str, "%1d", Liberte);+            strncat (chaine, str, (size_t) LEN2);+            strncat (chaine, " degrees of freedom", (size_t) LEN1);+            statcoll_SetDesc (res->Block[i]->sVal1, chaine);+            statcoll_Write (res->Block[i]->sVal1, 5, 14, 4, 3);+         }+      }+   }++   if (Liber > 0) {+      V[0] = Liber;+      gofw_ActiveTests2 (res->Bas->sVal1->V, res->Bas->pVal1->V, N,+         wdist_ChiSquare, V, res->Bas->sVal2, res->Bas->pVal2);+      res->Bas->pVal1->NObs = N;+      Sum = N * statcoll_Average (res->Bas->sVal1);+      res->Bas->sVal2[gofw_Sum] = Sum;+      res->Bas->pVal2[gofw_Sum] = fbar_ChiSquare2 (N*Liber, 12, Sum);++      if (swrite_Basic) {+         printf ("%s", res->Bas->sVal1->Desc);+         swrite_AddStrChi (str, LEN2, Liber);+         gofw_WriteActiveTests2 (N, res->Bas->sVal2, res->Bas->pVal2, str);+         swrite_Chi2SumTestb (N, res->Bas->sVal2[gofw_Sum],+                                 res->Bas->pVal2[gofw_Sum], Liber);+         if (swrite_Collectors) {+            strncpy (chaine, res->Bas->sVal1->Desc, (size_t) LEN1);+            strncat (chaine, ":   a ChiSquare with ", (size_t) LEN1);+            sprintf (str, "%1d", Liber);+            strncat (chaine, str, (size_t) LEN2);+            strncat (chaine, " degrees of freedom", (size_t) LEN1);+            statcoll_SetDesc (res->Bas->sVal1, chaine);+            statcoll_Write (res->Bas->sVal1, 5, 14, 4, 3);+         }+      }+   } else {+      /* for the module tvaria */+      res->Bas->pVal2[gofw_Mean] = -1.0;+      if (d < 1)+         util_Warning (1,+            "n is too small:   ChiSquare with 0 degree of freedom");+   }++   if (swrite_Basic)+      swrite_Final (gen, Timer);++   util_Free (Prob);+   util_Free (NbEsp5);+   util_Free (Count5);+   if (localRes)+      sstring_DeleteRes (res);+   chrono_Delete (Timer);+}
+ cbits/testu/src/statcoll.c view
@@ -0,0 +1,219 @@+/*************************************************************************\+ *+ * Package:        ProbDist+ * File:           statcoll.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "statcoll.h"++#include "util.h"+#include "tables.h"++#include <stddef.h>+#include <string.h>+++#define MAXLEN 127                /* Max number of chars in Desc field of a+                                     collector */++++/*=========================================================================*/++void statcoll_SetDesc (statcoll_Collector * S, const char name[])+{+   size_t len;+   util_Assert (S != NULL,+      "statcoll_SetDesc: statcoll_Collector is a NULL pointer");+   if (S->Desc != NULL)+      S->Desc = (char *) util_Free (S->Desc);+   if (name == NULL)+      return;+   len = strlen (name);+   if (len > MAXLEN) {+      len = MAXLEN;+      util_Warning (1, "statcoll_Collector->Desc truncated to 127 chars");+   }+   S->Desc = (char *) util_Calloc (len + 1, sizeof (char));+   strncpy (S->Desc, name, (size_t) len);+   S->Desc[len] = '\0';+}+++/*=========================================================================*/++statcoll_Collector *statcoll_Create (long N, const char name[])+{+   statcoll_Collector *S;++   util_Warning (N == 0,+      "statcoll_Create:   statcoll_Collector created with N = 0");+   S = (statcoll_Collector *) util_Malloc (sizeof (statcoll_Collector));+   /* We create an array V with N+1 elements, but will keep the N+      observations in elements [1..N]. */+   S->V = (double *) util_Calloc ((size_t) N + 1, sizeof (double));+   S->Dim = N;+   S->NObs = 0;+   S->Desc = NULL;+   statcoll_SetDesc (S, name);+   return S;+}+++/*=========================================================================*/++statcoll_Collector *statcoll_Delete (statcoll_Collector * S)+{+   if (S == NULL) {+      util_Warning (S == NULL,+         "statcoll_Delete:   statcoll_Collector is a NULL pointer");+      return NULL;+   }+   S->V = (double *) util_Free (S->V);+   S->Desc = (char *) util_Free (S->Desc);+   util_Free (S);+   return NULL;+}+++/*=========================================================================*/++void statcoll_Init (statcoll_Collector * S, long N)+{+   util_Assert (S != NULL,+      "statcoll_Init: statcoll_Collector is a NULL pointer");+   if (N > S->Dim) {+      S->V = (double *) util_Realloc (S->V, (N + 1) * sizeof (double));+      S->Dim = N;+   }+   S->NObs = 0;+}+++/*=========================================================================*/++void statcoll_AddObs (statcoll_Collector * S, double x)+{+   util_Assert (S != NULL,+      "statcoll_AddObs:   statcoll_Collector is a NULL pointer");+   if (S->NObs >= S->Dim) {+      if (S->Dim > 0)+         S->Dim *= 2;+      else+         S->Dim = 8;+      S->V = (double *) util_Realloc (S->V, (S->Dim + 1) * sizeof (double));+   }+   ++S->NObs;+   S->V[S->NObs] = x;+}+++/*=========================================================================*/++void statcoll_Write (statcoll_Collector * S, int k, int p1, int p2, int p3)+{+   tables_WriteTabD (S->V, 1, S->NObs, k, p1, p2, p3, S->Desc);+}+++/*=========================================================================*/++double statcoll_Average (statcoll_Collector * S)+{+   long i;+   double Sum;+   util_Assert (S != NULL,+      "statcoll_Average:   statcoll_Collector is a NULL pointer");+   Sum = 0.0;+   if (S->NObs == 0) {+      util_Warning (1, "statcoll_Average:   NObs = 0");+      return 1.0;+   }+   for (i = 1; i <= S->NObs; i++)+      Sum += S->V[i];+   return Sum / S->NObs;+}+++/*=========================================================================*/++double statcoll_Variance (statcoll_Collector * S)+{+   long i;+   double Av, Sum2, Diff;+   util_Assert (S != NULL,+      "statcoll_Variance:   statcoll_Collector is a NULL pointer");+   util_Assert (S->NObs > 1, "statcoll_Variance:   NObs <= 1");+   Av = statcoll_Average (S);+   Sum2 = 0.0;+   for (i = 1; i <= S->NObs; i++) {+      Diff = S->V[i] - Av;+      Sum2 += Diff * Diff;+   }+   return Sum2 / (S->NObs - 1);+}+++/*=========================================================================*/++double statcoll_AutoCovar (statcoll_Collector * S, int k)+{+   long i;+   double Av2, Sum2;+   util_Assert (S != NULL,+      "statcoll_AutoCovar:   statcoll_Collector is a NULL pointer");+   util_Assert (k < S->NObs, "statcoll_AutoCovar:   k >= NObs");+   Av2 = statcoll_Average (S);+   Av2 = Av2 * Av2;+   Sum2 = 0.0;+   for (i = 1; i <= S->NObs - k; i++) {+      Sum2 += S->V[i] * S->V[i + k] - Av2;+   }+   return Sum2 / (S->NObs - k);+}+++/*=========================================================================*/++double statcoll_Covar (statcoll_Collector * S1, statcoll_Collector * S2)+{+   long i;+   double Av1Av2, Sum;+   util_Assert (S1 != NULL,+      "statcoll_Covar:   statcoll_Collector S1 is a NULL pointer");+   util_Assert (S2 != NULL,+      "statcoll_Covar:   statcoll_Collector S2 is a NULL pointer");+   util_Assert (S1->NObs == S2->NObs,+      "statcoll_Covar:   S1->NObs != S2->NObs");+   util_Assert (S1->NObs > 1, "statcoll_Covar:   NObs <= 1");+   Av1Av2 = statcoll_Average (S1) * statcoll_Average (S2);+   Sum = 0.0;+   for (i = 1; i <= S1->NObs; i++) {+      Sum += S1->V[i] * S2->V[i] - Av1Av2;+   }+   return Sum / (S1->NObs - 1);+}
+ cbits/testu/src/svaria.c view
@@ -0,0 +1,1230 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           svaria.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "gdef.h"+#include "util.h"+#include "tables.h"+#include "chrono.h"+#include "num.h"+#include "num2.h"++#include "svaria.h"+#include "unif01.h"+#include "sres.h"+#include "wdist.h"+#include "swrite.h"+#include "smultin.h"++#include "fmass.h"+#include "gofs.h"+#include "gofw.h"++#include <math.h>+#include <float.h>+#include <limits.h>+#include <stdio.h>+#include <string.h>+++++lebool svaria_Timer = FALSE;+++++/*-------------------------------- Constants ------------------------------*/++/* Max string lengths */+#define LEN1 100+#define LEN2 200++/* Sample limit for normal approximation in svaria_SampleMean */+#define SAM_LIM 60++/* Arrays dimension in svaria_AppearanceSpacings */+#define AS_DIM 32++/* The Meschach package for matrix computations */+#undef MESCHACH++++++/*-------------------------------- Functions ------------------------------*/+++static void InitFDistMeans (int n, double Coef[])+/*+ * Initializes the distribution for svaria_SampleMean by computing the + * coefficients. We shall keep the value of n in element Coef[SAM_LIM],+ * since we shall need it to get the value of the distribution at x.+ */+{+   int s;+   double z;+   fmass_INFO Q;++   z = num2_Factorial (n);+   /* This uses the binomial formulae, but is not the binomial probability+      distribution since p + q != 1 */+   Q = fmass_CreateBinomial (n, -1.0, 1.0);+   for (s = 0; s <= n; s++)+      Coef[s] = fmass_BinomialTerm2 (Q, s) / z;+   fmass_DeleteBinomial (Q);+   Coef[SAM_LIM] = n;++   if (swrite_Classes) {+      printf ("---------------------------------------\n");+      for (s = 0; s <= n; s++) {+         printf ("   Coeff[%2d] = %14.6g\n", s, Coef[s]);+      }+      printf ("\n");+   }+}++/*-------------------------------------------------------------------------*/++static double FDistMeans (+   double C[],               /* Coefficients and sample size n */+   double x                  /* Argument */+   )+/* + * Distribution function of sample mean as in Stephens (1966), p.235.+ * This function is not very precise: the normal approximation is poor+ * for small x, and the computation of the exact function is numerically+ * unstable for large n. This will be used only for n < SAM_LIM. The+ * value of n is in  C[SAM_LIM].+ */+{+   double Sum;+   int M;+   int i;+   double nLR = C[SAM_LIM];+   int n = nLR;++   if (x <= 0.0)+      return 0.0;+   if (x >= n)+      return 1.0;++   M = x;+   Sum = 0.0;+   if (x < n / 2.0) {+      for (i = 0; i <= M; i++) {+         Sum += C[i] * pow (x, nLR);+         x -= 1.0;+      }+   } else {+      x = -x + nLR;+      for (i = n; i >= M + 1; i--) {+         Sum += C[i] * pow (x, nLR);+         x -= 1.0;+      }+      if (!(n & 1))+         Sum = -Sum;+      Sum += 1.0;+   }+   return Sum;+}++/*-------------------------------------------------------------------------*/++void svaria_SampleMean (unif01_Gen * gen, sres_Basic * res,+   long N, long n, int r)+{+   long i;+   long Seq;+   double Sum;+   double Coef[SAM_LIM + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "svaria_SampleMean test";++   Timer = chrono_Create ();+   if (swrite_Basic) {+      swrite_Head (gen, TestName, N, n, r);+      printf ("\n\n");+   }+   util_Assert (n > 1, "svaria_SampleMean:   n < 2");++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateBasic ();+   }+   sres_InitBasic (res, N, "svaria_SampleMean");+   if (n < SAM_LIM)+      InitFDistMeans (n, Coef);++   if (n < SAM_LIM)+      statcoll_SetDesc (res->sVal1, "SampleMean sVal1:   n*<U>");+   else+      statcoll_SetDesc (res->sVal1, "SampleMean sVal1:   standard normal");++   for (Seq = 1; Seq <= N; Seq++) {+      Sum = 0.0;+      for (i = 1; i <= n; i++)+         Sum += unif01_StripD (gen, r);++      if (n < SAM_LIM)+         statcoll_AddObs (res->sVal1, Sum);+      else+         statcoll_AddObs (res->sVal1, sqrt (12.0 / n) * (Sum - 0.5 * n));+   }++   if (n < SAM_LIM) {+      gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, FDistMeans, Coef,+                         res->sVal2, res->pVal2);+   } else {+      /* Normal approximation */+      gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Normal,+         (double *) NULL, res->sVal2, res->pVal2);+   }+   res->pVal1->NObs = N;++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,+         "Statistic value                       :");+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteBasic (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++void svaria_SampleCorr (unif01_Gen * gen, sres_Basic * res,+   long N, long n, int r, int k)+{+   long i;+   long Seq;+   double U;+   double Sum;+   double *Pre;                   /* Previous k generated numbers */+   int pos;                       /* Circular index to element at lag k */+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "svaria_SampleCorr test";++   Timer = chrono_Create ();+   if (swrite_Basic) {+      swrite_Head (gen, TestName, N, n, r);+      printf (",   k = %d\n\n", k);+   }+   util_Assert (n > 2, "svaria_SampleCorr:   n <= 2");++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateBasic ();+   }+   sres_InitBasic (res, N, "svaria_SampleCorr");+   statcoll_SetDesc (res->sVal1,+      "SampleCorr sVal1:   asymptotic standard normal");++   Pre = util_Calloc ((size_t) (k + 1), sizeof (double));++   for (Seq = 1; Seq <= N; Seq++) {+      /* Generate first k numbers U and keep them in Pre */+      for (i = 0; i < k; i++)+         Pre[i] = unif01_StripD (gen, r);++      Sum = 0.0;+      pos = 0;+      /* Element Pre[pos] is at lag k from U */+      for (i = k; i < n; i++) {+         U = unif01_StripD (gen, r);+         Sum += Pre[pos] * U - 0.25;+         Pre[pos] = U;+         pos++;+         pos %= k;+      }+      /* Save standardized correlation */+      statcoll_AddObs (res->sVal1, Sum * sqrt (12.0 / (n - k)));+   }++   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Normal,+       (double *) NULL, res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetNormalSumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,+         "Normal statistic                      :");+      swrite_NormalSumTest (N, res);+      swrite_Final (gen, Timer);+   }+   util_Free (Pre);+   if (localRes)+      sres_DeleteBasic (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static double FDistProd (+   double Par[],             /* The parameter t = Par[0] */+   double x                  /* The argument */+   )+/*+ * Compute the distribution function F for the product of t random variables+ * U[0, 1], where + *                          t - 1+ *                           __            j+ *  F[u1*u2*...ut <= x] = x \      (-ln(x))+ *                          /__    -----------+ *                          j = 0      j!+ *+ */+{+   double vlog, jterm, vterm, Sum;+   int j, t;++   if (x >= 1.0)+      return 1.0;+   if (x <= 0.0)+      return 0.0;++   vlog = log (x);+   t = Par[0];+   Sum = 1.0;+   vterm = 1.0;+   jterm = 1.0;+   for (j = 1; j < t; j++) {+      vterm *= vlog;+      jterm *= -j;+      Sum += vterm / jterm;+      if (vterm / jterm < DBL_EPSILON)+         break;+   }+   return x * Sum;+}+++/*-------------------------------------------------------------------------*/++void svaria_SampleProd (unif01_Gen * gen, sres_Basic * res,+   long N, long n, int r, int t)+{+   long i;+   int j;+   long Seq;+   double *P;+   double temp;+   double Par[1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "svaria_SampleProd test";++   Timer = chrono_Create ();+   if (swrite_Basic) {+      swrite_Head (gen, TestName, N, n, r);+      printf (",   t = %d\n\n", t);+   }++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateBasic ();+   }+   sres_InitBasic (res, N, "svaria_SampleProd");++   P = util_Calloc ((size_t) n + 1, sizeof (double));+   statcoll_SetDesc (res->sVal1, "SampleProd sVal1:   Uniform [0, 1]");+   Par[0] = t;++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = 1; i <= n; i++) {+         temp = unif01_StripD (gen, r);+         for (j = 2; j <= t; j++)+            temp *= unif01_StripD (gen, r);+         P[i] = temp;+      }+      gofw_ActiveTests1 (P, n, FDistProd, Par, res->sVal2, res->pVal2);+      statcoll_AddObs (res->sVal1, res->pVal2[gofw_AD]);+   }++   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Unif,+      (double *) NULL, res->sVal2, res->pVal2);+   res->pVal1->NObs = N;++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,+         "Anderson-Darling statistic            :");+      swrite_Final (gen, Timer);+   }+   util_Free (P);+   if (localRes)+      sres_DeleteBasic (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++void svaria_SumLogs (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r)+{+   const double Eps = DBL_EPSILON / 2.0;      /* To avoid log(0) */+   const double Epsilon = 1.E-100;            /* To avoid underflow */+   long i;+   long Seq;+   double u;+   double Prod;+   double Sum;+   double V[1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "svaria_SumLogs test";+   char chaine[LEN1 + 1] = "";+   char str[LEN2 + 1];++   Timer = chrono_Create ();+   if (swrite_Basic) {+      swrite_Head (gen, TestName, N, n, r);+      printf ("\n\n");+   }+   util_Assert (n < LONG_MAX/2, "2n > LONG_MAX");+   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, -1, "svaria_SumLogs");++   strncpy (chaine, "SumLogs sVal1:   chi2 with ", (size_t) LEN1);+   sprintf (str, "%ld", 2 * n);+   strncat (chaine, str, (size_t) LEN2);+   strncat (chaine, " degrees of freedom", (size_t) LEN1);+   statcoll_SetDesc (res->sVal1, chaine);+   res->degFree = 2 * n;+   if (res->degFree < 1) {+      util_Warning (TRUE, "Chi-square with 0 degree of freedom.");+      if (localRes)+         sres_DeleteChi2 (res);+      return;+   }++   for (Seq = 1; Seq <= N; Seq++) {+      Prod = 1.0;+      Sum = 0.0;+      for (i = 1; i <= n; i++) {+         u = unif01_StripD (gen, r);+         if (u < Eps)+            u = Eps;+         Prod *= u;+         if (Prod < Epsilon) {+            Sum += log (Prod);+            Prod = 1.0;+         }+      }+      statcoll_AddObs (res->sVal1, -2.0 * (Sum + log (Prod)));++   }+   V[0] = 2 * n;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+                      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      swrite_AddStrChi (str, LEN2, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataWeight (unif01_Gen * gen, char *TestName,+   long N, long n, int r, long k, double Alpha, double Beta)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",  k = %1ld,  Alpha = %6.4g,  Beta = %6.4g\n\n",+           k, Alpha, Beta);+}+++/*-------------------------------------------------------------------------*/++void svaria_WeightDistrib (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, long k, double Alpha, double Beta)+{+   long W;+   long j;+   long i;+   long Seq;+   double X;+   double U;+   double p;+   double nLR = n;+   double V[1];+   long NbClasses;+   long *Loc;+   fmass_INFO Q;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "svaria_WeightDistrib test";+   char chaine[LEN1 + 1] = "";+   char str[LEN2 + 1];++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataWeight (gen, TestName, N, n, r, k, Alpha, Beta);++   /*   util_Assert (n >= 3.0 * gofs_MinExpected,+	"svaria_WeightDistrib:   n is too small"); */+   util_Assert (Alpha <= 1.0 && Alpha >= 0.0,+      "svaria_WeightDistrib:    Alpha must be in [0, 1]");+   util_Assert (Beta <= 1.0 && Beta >= 0.0,+      "svaria_WeightDistrib:    Beta must be in [0, 1]");+   p = Beta - Alpha;++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, k, "svaria_WeightDistrib");+   Loc = res->Loc;++   /* Compute binomial probabilities and multiply by n */+   Q = fmass_CreateBinomial (k, p, 1.0 - p);+   for (i = 0; i <= k; i++)+      res->NbExp[i] = nLR * fmass_BinomialTerm2 (Q, i);+   fmass_DeleteBinomial (Q);++   res->jmin = 0;+   res->jmax = k;+   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, 0);++   /* Merge classes for the chi-square */+   gofs_MergeClasses (res->NbExp, Loc, &res->jmin, &res->jmax, &NbClasses);++   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, NbClasses);++   strncpy (chaine, "WeightDistrib sVal1:   chi2 with ", (size_t) LEN1);+   sprintf (str, "%ld", NbClasses - 1);+   strncat (chaine, str, (size_t) LEN2);+   strncat (chaine, " degrees of freedom", (size_t) LEN1);+   statcoll_SetDesc (res->sVal1, chaine);+   res->degFree = NbClasses - 1;+   if (res->degFree < 1) {+      if (localRes)+         sres_DeleteChi2 (res);+      return;+   }++   for (Seq = 1; Seq <= N; Seq++) {+      for (i = 0; i <= k; i++)+         res->Count[i] = 0;+      for (i = 1; i <= n; i++) {+         W = 0;+         for (j = 1; j <= k; j++) {+            U = unif01_StripD (gen, r);+            if (U >= Alpha && U < Beta)+               ++W;+         }+         if (W > res->jmax)+            ++res->Count[res->jmax];+         else+            ++res->Count[Loc[W]];+      }+      if (swrite_Counters)+         tables_WriteTabL (res->Count, res->jmin, res->jmax, 5, 10,+                           "Observed numbers:");++      X = gofs_Chi2 (res->NbExp, res->Count, res->jmin, res->jmax);+      statcoll_AddObs (res->sVal1, X);+   }++   V[0] = NbClasses - 1;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+                      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      swrite_AddStrChi (str, LEN2, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataArgMax (unif01_Gen * gen, char *TestName,+   long N, long n, int r, long k, long m)+{+   double x;++   swrite_Head (gen, TestName, N, n, r);+   printf (",   k = %1ld,   m = %1ld\n\n", k, m);+   printf ("   Number of balls = n = %1ld\n", n);+   printf ("   Number of urns  = k = %1ld\n", k);++   x = n;+   x = x * x / (2 * k);+   printf ("   Number (approx) of collisions = n^2 / 2k = %g\n\n\n", x);+}++/*-------------------------------------------------------------------------*/++static int svaria_CollisionArgMax_00 (unif01_Gen *gen, sres_Chi2 *res,+   long N, long n, int r, long k, long m)+/*+ * Return 0 if no error, otherwise return != 0.+ */+{+   double X;+   double U;+   double Max;+   long NbColl;+   long Indice = -1;+   long j;+   long i;+   long Rep;+   long Seq;+   long NbClasses;+   long *Loc;+   int *Urne;+   double V[1];+   fmass_INFO Q;+   lebool localRes = FALSE;+   chrono_Chrono *chro, *Timer;+   char *TestName = "svaria_CollisionArgMax test";+   char chaine[LEN1 + 1] = "";+   char str[LEN2 + 1];++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataArgMax (gen, TestName, N, n, r, k, m);++   util_Assert (n <= 4 * k, "svaria_CollisionArgMax:   n > 4k");+   /*   util_Assert (m > 2.0 * gofs_MinExpected,+	"svaria_CollisionArgMax:    m <= 2*gofs_MinExpected"); */++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, n, "svaria_CollisionArgMax");+   Loc = res->Loc;+   Urne = util_Calloc ((size_t) k + 1, sizeof (int));++   if (svaria_Timer) {+      printf ("-----------------------------------------------");+      printf ("\nCPU time to initialize the collision distribution:  ");+      chro = chrono_Create ();+   }+   Q = smultin_CreateCollisions (n, (smultin_CellType) k);+   if (svaria_Timer) {+      chrono_Write (chro, chrono_hms);+      printf ("\n\n");+   }++   /* Compute the expected numbers of collisions: m*P(j) */+   for (j = 0; j <= n; j++)+      res->NbExp[j] = m * smultin_CollisionsTerm (Q, j);+   smultin_DeleteCollisions (Q);++   res->jmin = 0;+   res->jmax = n;+   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, 0);++   gofs_MergeClasses (res->NbExp, Loc, &res->jmin, &res->jmax, &NbClasses);++   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, NbClasses);++   strncpy (chaine, "CollisionArgMax sVal1:   chi2 with ", (size_t) LEN1);+   sprintf (str, "%ld", NbClasses - 1);+   strncat (chaine, str, (size_t) LEN2);+   strncat (chaine, " degrees of freedom", (size_t) LEN1);+   statcoll_SetDesc (res->sVal1, chaine);+   res->degFree = NbClasses - 1;+   if (res->degFree < 1) {+      if (localRes)+         sres_DeleteChi2 (res);+      return 1;+   }++   if (svaria_Timer)+      chrono_Init (chro);++   for (Seq = 1; Seq <= N; Seq++) {+      for (j = 0; j <= n; j++)+         res->Count[j] = 0;++      for (Rep = 1; Rep <= m; Rep++) {+         for (j = 0; j <= k; j++)+            Urne[j] = -1;++         NbColl = 0;+         for (j = 1; j <= n; j++) {+            Max = -1.0;+            for (i = 1; i <= k; i++) {+               U = unif01_StripD (gen, r);+               if (U > Max) {+                  Max = U;+                  Indice = i;+               }+            }+            if (Urne[Indice] < 0)+               Urne[Indice] = 1;+            else+               ++NbColl;+         }+         if (NbColl > res->jmax)+            ++res->Count[res->jmax];+         else+            ++res->Count[Loc[NbColl]];+      }+      if (swrite_Counters)+         tables_WriteTabL (res->Count, res->jmin, res->jmax, 5, 10,+                           "Observed numbers:");+      X = gofs_Chi2 (res->NbExp, res->Count, res->jmin, res->jmax);+      statcoll_AddObs (res->sVal1, X);+   }++   if (svaria_Timer) {+      printf ("\n----------------------------------------------\n"+              "CPU time for the test           :  ");+      chrono_Write (chro, chrono_hms);+      printf ("\n\n");+      chrono_Delete (chro);+   }++   V[0] = NbClasses - 1;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+                      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);+   +   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      swrite_AddStrChi (str, LEN2, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   util_Free (Urne);+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+   return 0;+}+++/*-------------------------------------------------------------------------*/++void svaria_CollisionArgMax (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, long k, long m)+{+   if (m > 1) {+      svaria_CollisionArgMax_00 (gen, res, N, n, r, k, m);++   } else if (m == 1) {+      double ValDelta[] = { -1.0 };+      smultin_Param *par;++      if (swrite_Basic) {+         printf (+          "***********************************************************\n"+          "Test svaria_CollisionArgMax calling smultin_Multinomial\n\n");+      }+      par = smultin_CreateParam (1, ValDelta, smultin_GenerCellMax, -3);+      if (NULL == res) {+         smultin_Multinomial (gen, par, NULL, N, n, r, 0, k, TRUE);+      } else {+         smultin_Res *resm;+         resm = smultin_CreateRes (par);+         smultin_Multinomial (gen, par, resm, N, n, r, 0, k, TRUE);+         sres_InitChi2 (res, N, -1, "svaria_CollisionArgMax");+         statcoll_SetDesc (res->sVal1, "CollisionArgMax sVal1");+         res->sVal1->NObs = resm->Collector[0]->NObs;+         tables_CopyTabD (resm->Collector[0]->V, res->sVal1->V, 1, N);+         tables_CopyTabD (resm->sVal2[0], res->sVal2, 0, gofw_NTestTypes - 1);+         tables_CopyTabD (resm->pVal2[0], res->pVal2, 0, gofw_NTestTypes - 1);+         smultin_DeleteRes (resm);+      }+      smultin_DeleteParam (par);+   } else {+     util_Warning (m <= 0, "svaria_CollisionArgMax:   m <= 0");+   }+}+++/*=========================================================================*/++static void WriteDataSumColl (unif01_Gen * gen, char *TestName,+   long N, long n, int r, double g)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   g = %g\n\n", g);+}++/*-------------------------------------------------------------------------*/++static double ProbabiliteG (int jmin, int j, double g)+/* + * Returns the probability that the minimum number of random U(0,1) whose+ * sum is larger than g is j+1. g cannot be too large because the+ * calculation here becomes numerically unstable.+ */+{+   int s;+   double temp;+   const double jLR = j;+   double signe;                  /* +1 or -1 */+   double somme;++   signe = 1.0;+   somme = 0.0;+   for (s = 0; s <= jmin; s++) {+      temp = signe * num2_Combination (j + 1, s);+      temp *= pow (g - s, jLR);+      somme += temp;+      signe = -signe;+   }+   somme = (jLR + 1.0 - g) * somme / num2_Factorial (j + 1);+   return somme;+}+++/*-------------------------------------------------------------------------*/++void svaria_SumCollector (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, double g)+{+   const double gmax = 10.0;      /* Maximal value of g */+   const int jmax = 50;           /* Maximal number of classes */+   int j;                         /* Class index */+   long Seq;+   long i;+   double X;+   double Y;+   double Sum;+   long NbClasses;+   long *Loc;+   double V[1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "svaria_SumCollector test";+   char chaine[LEN1 + 1] = "";+   char str[LEN2 + 1];++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataSumColl (gen, TestName, N, n, r, g);++   if (g < 1.0 || g > gmax) {+      util_Error ("svaria_SumCollector:   g < 1.0 or g > 10.0");+   }+   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, jmax, "svaria_SumCollector");+   Loc = res->Loc;++   res->jmin = g;+   res->jmax = jmax;+   Sum = 0.0;+   for (j = res->jmin; j < jmax; j++) {+      res->NbExp[j] = n * ProbabiliteG (res->jmin, j, g);+      Sum += res->NbExp[j];+   }+   res->NbExp[jmax] = util_Max (0.0, n - Sum);++   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, 0);+   gofs_MergeClasses (res->NbExp, Loc, &res->jmin, &res->jmax, &NbClasses);+   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, Loc, res->jmin, res->jmax, NbClasses);++   strncpy (chaine, "SumCollector sVal1:   chi2 with ", (size_t) LEN1);+   sprintf (str, "%ld", NbClasses - 1);+   strncat (chaine, str, (size_t) LEN2);+   strncat (chaine, " degrees of freedom", (size_t) LEN1);+   statcoll_SetDesc (res->sVal1, chaine);+   res->degFree = NbClasses - 1;+   if (res->degFree < 1) {+      if (localRes)+         sres_DeleteChi2 (res);+      return;+   }++   for (Seq = 1; Seq <= N; Seq++) {+      for (j = 1; j <= jmax; j++)+         res->Count[j] = 0;++      for (i = 1; i <= n; i++) {+         X = 0.0;+         j = 0;+         do {+            X += unif01_StripD (gen, r);+            ++j;+         }+         while (X <= g);+         if (j > res->jmax)+            ++res->Count[res->jmax];+         else+            ++res->Count[Loc[j - 1]];+      }+      if (swrite_Counters)+         tables_WriteTabL (res->Count, res->jmin, res->jmax, 5, 10,+                           "Observed numbers:");+      Y = gofs_Chi2 (res->NbExp, res->Count, res->jmin, res->jmax);+      statcoll_AddObs (res->sVal1, Y);+   }++   V[0] = NbClasses - 1;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+                      res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetChi2SumStat (res);+   +   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      swrite_AddStrChi (str, LEN2, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void InitAppear (int r, int s, int L, long Q, double E[], double KV[])+{+   util_Assert (r >= 0, "svaria_AppearanceSpacings:   r < 0");+   util_Assert (s > 0, "svaria_AppearanceSpacings:   s <= 0");+   /*   if (L >= s && L % s) {+      util_Error ("svaria_AppearanceSpacings:   L mod s != 0");+      }*/+   if (L < s && s % L) {+      util_Error ("svaria_AppearanceSpacings:   s mod L != 0");+   }+   util_Warning (Q < 10.0 * num_TwoExp[L],+      "svaria_AppearanceSpacings:   Q < 10 * 2^L");++   /* Theoretical mean E and variance KV for different L given by Maurer */+   if (L > 16) {+      /* For L > 16 and near 16, the 6-th decimal of E[L] could be+         erroneous. For KV [L], the 4-th decimal. */+      E[L] = L - 8.32746E-1;+      KV[L] = 3.423715;+   } else {+      E [1]  = 0.73264948;      KV[1]  = 0.68977;+      E [2]  = 1.53743829;      KV[2]  = 1.33774;+      E [3]  = 2.40160681;      KV[3]  = 1.90133;+      E [4]  = 3.31122472;      KV[4]  = 2.35774;+      E [5]  = 4.25342659;      KV[5]  = 2.70455;+      E [6]  = 5.21770525;      KV[6]  = 2.95403;+      E [7]  = 6.19625065;      KV[7]  = 3.12539;+      E [8]  = 7.18366555;      KV[8]  = 3.23866;+      E [9]  = 8.17642476;      KV[9]  = 3.31120;+      E [10] = 9.17232431;      KV[10] = 3.35646;+      E [11] = 10.1700323;      KV[11] = 3.38409;+      E [12] = 11.1687649;      KV[12] = 3.40065;+      E [13] = 12.1680703;      KV[13] = 3.41043;+      E [14] = 13.1676926;      KV[14] = 3.41614;+      E [15] = 14.1674884;      KV[15] = 3.41943;+      E [16] = 15.1673788;      KV[16] = 3.42130;+   }+}++/*-------------------------------------------------------------------------*/++static double CalcSigma (int L, long K, double KV[])+/*+ * Compute the standard deviation for the svaria_AppearanceSpacings test.+ */+{+   double dCor[AS_DIM + 1];        /* Coron-Naccache factor d */+   double eCor[AS_DIM + 1];        /* Coron-Naccache factor e */+   double temp;+   /*   double c; */++#if 0     /* No correction */+   return sqrt (KV[L] / K);++#elif 0   /* Maurer's correction c(L, K) */+   temp = 3.0 / L * num_Log2 ((double) K);+   if (temp >= DBL_MAX_EXP - 1)+      temp = 0.0;+   else+      temp = pow (2.0, -temp);+   c = 0.7 - 0.8/L + (4.0 + 32.0/L) * temp / 15.0;+   if (L < 3 || L > 16)+      c = 1.0;+   return c * sqrt (KV[L] / K);++#else   /* based on Coron and Naccache exact calculation */+   dCor [3]  = 0.2732725;        eCor [3]  = 0.4890883;+   dCor [4]  = 0.3045101;        eCor [4]  = 0.4435381;+   dCor [5]  = 0.3296587;        eCor [5]  = 0.4137196;+   dCor [6]  = 0.3489769;        eCor [6]  = 0.3941338;+   dCor [7]  = 0.3631815;        eCor [7]  = 0.3813210;+   dCor [8]  = 0.3732189;        eCor [8]  = 0.3730195;+   dCor [9]  = 0.3800637;        eCor [9]  = 0.3677118;+   dCor [10] = 0.3845867;        eCor [10] = 0.3643695;+   dCor [11] = 0.3874942;        eCor [11] = 0.3622979;+   dCor [12] = 0.3893189;        eCor [12] = 0.3610336;+   dCor [13] = 0.3904405;        eCor [13] = 0.3602731;+   dCor [14] = 0.3911178;        eCor [14] = 0.3598216;+   dCor [15] = 0.3915202;        eCor [15] = 0.3595571;+   dCor [16] = 0.3917561;        eCor [16] = 0.3594040;+   /* L = infinite */+   dCor [0]  = 0.3920729;        eCor [0]  = 0.3592016;++   if (L < 3)+      return sqrt (KV[L] / K);+   if (L > 16)+      temp = dCor[0] + eCor [0] * num_TwoExp[L] / K;+   else+      temp = dCor[L] + eCor [L] * num_TwoExp[L] / K;+   return sqrt (temp * KV[L] / K);+   +#endif+}++/*-------------------------------------------------------------------------*/++static void WriteDataAppear (unif01_Gen * gen,+   long N, int r, int s, int L, long Q, long K, double n)+{+   printf ("***********************************************************\n");+   printf ("HOST = ");+   if (swrite_Host) {+      gdef_WriteHostName ();+      printf ("\n");+   } else +      printf ("\n\n");+   unif01_WriteNameGen (gen);+   printf ("\n");+   if (swrite_ExperimentName && strcmp (swrite_ExperimentName, "")) {+      printf ("%s", swrite_ExperimentName);+      printf (":\n\n");+   }++   printf ("svaria_AppearanceSpacings test:\n"+          "-----------------------------------------------\n");++   printf ("   N = %2ld,   Q = %1ld,   K = %1ld,   r = %1d,   s = %1d,"+           "   L = %1d\n\n", N, Q, K, r, s, L);+   printf ("   Sequences of n = (K + Q)L = %12.0f bits\n", n);+   printf ("   Q = %4ld initialization blocks\n", Q);+   printf ("   K = %4ld blocks for the test\n", K);+   printf ("   the blocks have L = %2d bits\n\n\n", L);+}+++/*-------------------------------------------------------------------------*/++void svaria_AppearanceSpacings (unif01_Gen * gen, sres_Basic * res,+   long N, long Q, long K, int r, int s, int L)+{+   double E[AS_DIM + 1];          /* Theoretical mean of the log (Base2) of+                                     the most recent occurrence of a block */+   double KV[AS_DIM + 1];         /* K times the theoretical variance of the+                                     same */+   long Seq;+   long block;+   long Nblocks;                  /* 2^L = total number of distinct blocks */+   long K2;+   long Q2;+   long i;+   long sBits;                    /* Numerical value of the s given bits */+   long d;                        /* 2^s */+   const int SdivL = s / L;+   const int LdivS = L / s;+   const int LmodS = L % s;+   long sd;                       /* 2^LmodS */+   long rang;+   double n;                      /* Total number of bits in a sequence */+   double sigma;                  /* Standard deviation = sqrt (Variance) */+   double somme;+   double ARang;                  /* Most recent occurrence of block */+   long *Count;                   /* Index of most recent occurrence of+                                     block */+   double FactMoy;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;++   Timer = chrono_Create ();+   n = ((double) K + (double) Q) * L;+   if (swrite_Basic)+      WriteDataAppear (gen, N, r, s, L, Q, K, n);+   util_Assert (s < 32, "svaria_AppearanceSpacings:   s >= 32");+   InitAppear (r, s, L, Q, E, KV);+   sigma = CalcSigma (L, K, KV);+   d = num_TwoExp[s];+   Nblocks = num_TwoExp[L];+   FactMoy = 1.0 / (num_Ln2 * K);++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateBasic ();+   }+   sres_InitBasic (res, N, "svaria_AppearanceSpacings");+   Count = util_Calloc ((size_t) Nblocks + 2, sizeof (long));++   statcoll_SetDesc (res->sVal1,+      "AppearanceSpacings sVal1:   standard normal");++   if (LdivS > 0) {+      sd = num_TwoExp[LmodS];++      for (Seq = 1; Seq <= N; Seq++) {+         for (i = 0; i < Nblocks; i++)+            Count[i] = 0;++         /* Initialization with Q blocks */+         for (rang = 0; rang < Q; rang++) {+            block = 0;+            for (i = 1; i <= LdivS; i++) {+               sBits = unif01_StripB (gen, r, s);+               block = block * d + sBits;+            }+            if (LmodS > 0) {+               sBits = unif01_StripB (gen, r, LmodS);+               block = block * sd + sBits;+            }+            Count[block] = rang;+         }++         /* Test proper with K blocks */+         somme = 0.0;+         for (rang = Q; rang < Q + K; rang++) {+            block = 0;+            for (i = 1; i <= LdivS; i++) {+               sBits = unif01_StripB (gen, r, s);+               block = block * d + sBits;+            }+            if (LmodS > 0) {+               sBits = unif01_StripB (gen, r, LmodS);+               block = block * sd + sBits;+            }+            ARang = rang - Count[block];+            somme += log (ARang);+            Count[block] = rang;+         }+         statcoll_AddObs (res->sVal1, (somme * FactMoy - E[L]) / sigma);+      }++   } else {                       /* s > L */+      Q2 = Q / SdivL;+      K2 = K / SdivL;+      for (Seq = 1; Seq <= N; Seq++) {+         for (i = 0; i < Nblocks; i++)+            Count[i] = 0;++         /* Initialization: Q blocks */+         for (rang = 0; rang < Q2; rang++) {+            sBits = unif01_StripB (gen, r, s);+            for (i = 0; i < SdivL; i++) {+               block = sBits % Nblocks;+               Count[block] = SdivL * rang + i;+               sBits /= Nblocks;+            }+         }+         /* Test proper with K blocks */+         somme = 0.0;+         for (rang = Q2; rang < Q2 + K2; rang++) {+            sBits = unif01_StripB (gen, r, s);+            for (i = 0; i < SdivL; i++) {+               block = sBits % Nblocks;+               ARang = SdivL * rang + i - Count[block];+               somme += log (ARang);+               Count[block] = SdivL * rang + i;+               sBits /= Nblocks;+            }+         }+         statcoll_AddObs (res->sVal1, (somme * FactMoy - E[L]) / sigma);+      }+   }++   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_Normal,+      (double *) NULL, res->sVal2, res->pVal2);+   res->pVal1->NObs = N;+   sres_GetNormalSumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 12, 4, 3);++   if (swrite_Basic) {+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2,+         "Normal statistic                      :");+      swrite_NormalSumTest (N, res);+      swrite_Final (gen, Timer);+   }+   util_Free (Count);+   if (localRes)+      sres_DeleteBasic (res);+   chrono_Delete (Timer);+}
+ cbits/testu/src/swalk.c view
@@ -0,0 +1,1250 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           swalk.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"+#include "chrono.h"+#include "num.h"+#include "num2.h"+#include "bitset.h"++#include "swalk.h"+#include "wdist.h"+#include "swrite.h"+#include "unif01.h"++#include "fmass.h"+#include "fbar.h"+#include "gofw.h"+#include "gofs.h"++#include <math.h>+#include <stddef.h>+#include <string.h>+++++/*------------------------------- Constants -------------------------------*/++#define PREC 52                   /* Max number of bits in a number */+#define LENGTH 200                 /* Max length of strings */+++typedef enum {+   swalk_rwH,                         /* H statistic */+   swalk_rwM,                         /* M statistic */+   swalk_rwJ,                         /* J statistic */+   swalk_rwR,                         /* R statistic */+   swalk_rwC,                         /* C statistic */+   swalk_rw_N                         /* Total number of statistics here */+} swalk_rwType;++/* The name of each type of statistic in swalk_rwType (predefined). */+static const char *swalk_rwName[swalk_rw_N] = {+   "Statistic H",+   "Statistic M",+   "Statistic J",+   "Statistic R",+   "Statistic C"+};+++/*--------------------------------- Types ---------------------------------*/++typedef struct {+   long X;+   long S;+   long S_2;+   long M;+   long R;+   long J;+   long C;+} WorkType;+++/* Type of algorithm used in swalk_VarGeo */+typedef enum {+   swalk_AlgoP,+   swalk_AlgoN+   } swalk_AlgoType;+++++/*-------------------------------- functions ------------------------------*/++static void CalcNbExp (+   long n,                    /* Sample size */+   long L0,+   long k,+   swalk_Res *res+   )+/* + ************   IMPORTANT: we assume that L is even  ************+ * Compute the expected numbers for the different statistics in the+ * swalk_RandomWalk1 and swalk_RandomWalk1a tests. We start from the+ * maximum term and compute on each side all terms larger than epsilon.+ * We set all others to 0.+ */+{+   const double epsilon = 1.0E-16;+   double *NbExp;+   long L1, L2;+   const long L = L0 + k;+   long i;+   double nLR = n;+   double epsn;++   util_Assert (!(L & 1), "CalcNbExp:   L is odd");+   L2 = L / 2;+   epsn = epsilon * nLR;++   /*----------- statistic H -----------*/+   NbExp = res->H[k]->NbExp;+   for (i = 0; i <= L; i++)+      NbExp[i] = 0.0;++   NbExp[L2] = nLR * fmass_BinomialTerm1 (L, 0.5, 0.5, L2);+   i = L2;+   while (i > 0 && NbExp[i] > epsn) {+      NbExp[i - 1] = NbExp[i] * i / (L - i + 1);+      --i;+   }+   i = L2;+   while (i < L && NbExp[i] > epsn) {+      NbExp[i + 1] = NbExp[i] * (L - i) / (i + 1);+      ++i;+   }++   /*----------- statistic M -----------*/+   NbExp = res->M[k]->NbExp;+   for (i = 0; i <= L; i++)+      NbExp[i] = 0.0;++   NbExp[0] = res->H[k]->NbExp[L2];+   i = 0;+   while (i < L && NbExp[i] > epsn) {+      NbExp[i + 1] = NbExp[i] * ((L - i) / 2) / ((L + i) / 2 + 1);+      NbExp[i + 2] = NbExp[i + 1];+      i += 2;+   }++   /*----------- statistic J -----------*/+   NbExp = res->J[k]->NbExp;+   for (i = 0; i <= L; i++)+      NbExp[i] = 0.0;++   NbExp[0] = res->M[k]->NbExp[0];+   NbExp[L] = NbExp[0];+   i = 0;+   while (i < L2 && NbExp[i] > epsn) {+      NbExp[i + 2] = NbExp[i] * ((L - i) / 2) *+         (1 + i) / ((double)(i / 2 + 1) * (L - i - 1));+      NbExp[L - i - 2] = NbExp[i + 2];+      i += 2;+   }++   /*----------- statistic R -----------*/+   NbExp = res->R[k]->NbExp;+   for (i = 0; i <= L; i++)+      NbExp[i] = 0.0;++   NbExp[0] = res->J[k]->NbExp[0];+   i = 0;+   while (i < L2 && NbExp[i] > epsn) {+      NbExp[i + 1] = NbExp[i] * (L - 2 * i) / (L - i);+      ++i;+   }++   /*----------- statistic C -----------*/+   NbExp = res->C[k]->NbExp;+   for (i = 0; i <= L; i++)+      NbExp[i] = 0.0;++   NbExp[0] = 2.0 * nLR * fmass_BinomialTerm1 (L - 1, 0.5, 0.5, L2);+   i = 0;+   L1 = L2 - 1;+   while (i < L1 && NbExp[i] > epsn) {+      NbExp[i + 1] = NbExp[i] * (L2 - i - 1) / (L2 + i + 1);+      ++i;+   }+}+++/*-------------------------------------------------------------------------*/++static void WriteTabWalk (+   swalk_Res *res,+   long N                 /* Number of replications */+   )+/*+ * Write the values of the statistics and their p-values in a table+ * for all values of the walk length L from L0 to L1. These values have+ * all been written before, but it is nice to have them all together.+ * When L0 = L1, it is not useful. When the number of replications N > 1, it + * is not called either because there would be so many statistics to write.+ */+{+   swalk_rwType m;+   long k;+   double p;+   long L0 = res->L0;             /* Shortest walk length considered */+   long L1 = res->L1;             /* Longest walk length considered */++   if (L1 == L0)+      return;+   if (N > 1)+      return;+   printf ("\n\n***********************************************"+           "\nTABLES FOR THE RESULTS ABOVE");+   for (m = 0; m < swalk_rw_N; m++) {+      printf ("\n\n===============================================\n");+      printf ("Test on the values of the ");+      printf ("%s", swalk_rwName[m]);+      printf ("\n\n  Walk length      Chi-square        p-value\n\n");++      for (k = 0; k <= L1 - L0; k += 2) {+         printf ("%8ld", L0 + k);+         switch (m) {+         case swalk_rwH:+            num_WriteD (res->H[k]->sVal2[gofw_Mean], 18, 3, 2);+            p = res->H[k]->pVal2[gofw_Mean];+            break;+         case swalk_rwM:+            num_WriteD (res->M[k]->sVal2[gofw_Mean], 18, 3, 2);+            p = res->M[k]->pVal2[gofw_Mean];+            break;+         case swalk_rwJ:+            num_WriteD (res->J[k]->sVal2[gofw_Mean], 18, 3, 2);+            p = res->J[k]->pVal2[gofw_Mean];+            break;+         case swalk_rwR:+            num_WriteD (res->R[k]->sVal2[gofw_Mean], 18, 3, 2);+            p = res->R[k]->pVal2[gofw_Mean];+            break;+         case swalk_rwC:+            num_WriteD (res->C[k]->sVal2[gofw_Mean], 18, 3, 2);+            p = res->C[k]->pVal2[gofw_Mean];+            break;+         default:+            util_Error ("swalk:  WriteTabWalk: no such case");+         }+         num_WriteD (p, 18, 3, 2);+         if (p < gofw_Suspectp || p > 1.0 - gofw_Suspectp) {+            printf ("     *****");+         }+         printf ("\n");+      }+   }+   printf ("\n\n");+}+++/*-------------------------------------------------------------------------*/++static void WriteResultWalk (+   swalk_Res *res,+   long N                 /* Number of replications */+   )+/*+ * Write the basic results of the swalk_RandomWalk1 and swalk_RandomWalk1a+ * tests for all walks of length L between L0 and L1. May write the+ * statistical collectors too. + */+{+   swalk_rwType m;+   long L0 = res->L0;             /* Shortest walk length considered */+   long L1 = res->L1;             /* Longest walk length considered */+   long k;+   sres_Chi2 *Q;++   printf ("\n");+   for (k = 0; k <= L1 - L0; k += 2) {+      if (L1 > L0) {+	 printf ("\n\n==============================================="+	         "\nWALK OF %3ld STEPS\n", L0 + k);+      }+      for (m = 0; m < swalk_rw_N; m++) {+	 printf ("-----------------------------------------------\n"+                 "Test on the values of the ");+         printf ("%s", swalk_rwName[m]);+         printf ("\n\n");+         switch (m) {+         case swalk_rwH:+            Q = res->H[k];+            break;+         case swalk_rwM:+            Q = res->M[k];+            break;+         case swalk_rwJ:+            Q = res->J[k];+            break;+         case swalk_rwR:+            Q = res->R[k];+            break;+         case swalk_rwC:+            Q = res->C[k];+            break;+         default:+            util_Error ("swalk:  WriteResultWalk: no such case");+         }+         if (N == 1) {+            printf ("Number of degrees of freedom          : %4ld\n",+                 Q->degFree);+            printf ("ChiSquare statistic                   :");+            gofw_Writep2 (Q->sVal2[gofw_Mean], Q->pVal2[gofw_Mean]);+         } else {+            gofw_WriteActiveTests0 (N, Q->sVal2, Q->pVal2);+            swrite_Chi2SumTest (N, Q);+         }+         printf ("\n");+         if (swrite_Collectors)+            statcoll_Write (Q->sVal1, 5, 14, 4, 3);+      }+   }+   WriteTabWalk (res, N);+}+++/*-------------------------------------------------------------------------*/++static void WriteDetailsWalk (+   swalk_Res *res,+   long k,               /* Walk length L = k + L0 */+   long n                /* sample size */+   )+/*+ * Write detailed results for the different statistics of a walk of length+ * L = k + L0: the expected numbers, the observed numbers (the counters),+ * and the normalized values. If the normalized value is outside the interval+ * [-3, 3], we indicate it explicitly.++ */+{+   swalk_rwType m;+   long i;+   double iObs;                   /* Weighted sum of the observed numbers */+   double Obs;                    /* Observed numbers */+   double iEsp;                   /* Weighted sum of the expected numbers */+   double Esp;                    /* Expected numbers */+   double Z;                      /* Normalized value */+   double Var;                    /* Variance */+   long L0 = res->L0;             /* Shortest length of walks considered */+   double nLR = n;+   sres_Chi2 *Q;++   printf ("================================================\n");+   printf ("Walk of %3ld steps\n", L0 + k);++   for (m = 0; m < swalk_rw_N; m++) {+      printf ("------------------------------------------------\n"+              "Counters of the ");+      printf ("%s", swalk_rwName[m]);+      printf+         ("\n\n  i     Expected num. Observed num.  (Exp. - Obs.)/sigma\n\n");+      iEsp = 0.0;+      iObs = 0.0;+      switch (m) {+      case swalk_rwH:+         Q = res->H[k];+         break;+      case swalk_rwM:+         Q = res->M[k];+         break;+      case swalk_rwJ:+         Q = res->J[k];+         break;+      case swalk_rwR:+         Q = res->R[k];+         break;+      case swalk_rwC:+         Q = res->C[k];+         break;+      default:+         util_Error ("swalk:  WriteDetailsWalk: no such case");+      }+      i = Q->jmin - 1;+      do {+         i = Q->Loc[i + 1];+         Esp = Q->NbExp[i];+         Obs = Q->Count[i];+         iEsp = iEsp + Esp * i;   /* Expected value of the statistic */+         iObs = iObs + Obs * i;   /* Observed mean of the statistic */++         /* If Esp = 0, this is a class that has been redirected to another+            for the ChiSquare test; we shall not print it since the counters +            have been redirected also: they are necessarily 0. */+         if (Esp > 0.0) {+            printf ("%4ld", i);+            num_WriteD (Esp, 14, 2, 0);+            num_WriteD (Obs, 12, 0, 0);+            Var = Esp * (1.0 - Esp / nLR);+            if (Var <= 0.0)+               Z = (Obs - Esp) * 1.E100;+            else+               Z = (Obs - Esp) / sqrt (Var);+            num_WriteD (Z, 18, 4, 3);+            if (Z > 3.0 || Z < -3.0)+               printf ("    *****");+            printf ("\n");+         }+      } while (i != Q->jmax);++      printf ("\nExpected mean  = ");+      num_WriteD (iEsp / nLR, 10, 2, 0);+      printf ("\nEmpirical mean = ");+      num_WriteD (iObs / nLR, 10, 2, 0);+      printf ("\n\n");+   }+   printf ("\n");+}+++/*-------------------------------------------------------------------------*/++static void WriteDataWalk1 (unif01_Gen *gen, char *TestName,+   long N, long n, int r, int s, long L0, long L1)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   s = %1d,   L0 = %4ld,   L1 = %4ld\n\n\n", s, L0, L1);+}+++/*=========================================================================*/++swalk_Res * swalk_CreateRes (void)+{+   swalk_Res *res;++   res = util_Malloc (sizeof (swalk_Res));+   memset (res, 0, sizeof (swalk_Res));+   res->H = util_Calloc (1, sizeof (sres_Chi2 *));+   res->M = util_Calloc (1, sizeof (sres_Chi2 *));+   res->J = util_Calloc (1, sizeof (sres_Chi2 *));+   res->R = util_Calloc (1, sizeof (sres_Chi2 *));+   res->C = util_Calloc (1, sizeof (sres_Chi2 *));+   res->H[0] = sres_CreateChi2 ();+   res->M[0] = sres_CreateChi2 ();+   res->J[0] = sres_CreateChi2 ();+   res->R[0] = sres_CreateChi2 ();+   res->C[0] = sres_CreateChi2 ();+   res->imax = 0;+   res->name = util_Calloc (1, sizeof (char));+   return res;+}+++/*-------------------------------------------------------------------------*/++void swalk_DeleteRes (swalk_Res *res)+{+   long i;++   if (res == NULL)+      return;+   util_Free (res->name);+   for (i = 0; i <= res->imax; i += 2) {+      sres_DeleteChi2 (res->H[i]);+      sres_DeleteChi2 (res->M[i]);+      sres_DeleteChi2 (res->R[i]);+      sres_DeleteChi2 (res->J[i]);+      sres_DeleteChi2 (res->C[i]);+   }+   util_Free (res->H);+   util_Free (res->R);+   util_Free (res->M);+   util_Free (res->J);+   util_Free (res->C);+   util_Free (res);+}+++/*-------------------------------------------------------------------------*/++static void InitRes (+   swalk_Res *res,+   WorkType *work,+   long N,                /* Number of replications */+   long L0,               /* Shortest walk length considered */+   long L1,               /* Longest walk length considered */+   char *nam+)+/*+ * Allocates memory for arrays to be used in the swalk_RandomWalk1a and+ * swalk_RandomWalk1 tests. Arrays for walk length L will be indexed+ * by i = L - L0.+ */+{+   long i, imax, L;++   util_Assert (!(L0 & 1), "InitRes:   L0 is odd");+   if (L1 & 1)+      L1--;+   util_Assert (L1 >= L0, "InitRes:   L1 < L0");+   imax = L1 - L0;++   for (i = imax + 2; i <= res->imax; i += 2) {+      sres_DeleteChi2 (res->H[i]);+      sres_DeleteChi2 (res->M[i]);+      sres_DeleteChi2 (res->R[i]);+      sres_DeleteChi2 (res->J[i]);+      sres_DeleteChi2 (res->C[i]);+   }+   res->H = util_Realloc (res->H, ((size_t) imax + 1) * sizeof(sres_Chi2 *));+   res->R = util_Realloc (res->R, ((size_t) imax + 1) * sizeof(sres_Chi2 *));+   res->M = util_Realloc (res->M, ((size_t) imax + 1) * sizeof(sres_Chi2 *));+   res->J = util_Realloc (res->J, ((size_t) imax + 1) * sizeof(sres_Chi2 *));+   res->C = util_Realloc (res->C, ((size_t) imax + 1) * sizeof(sres_Chi2 *));++   for (i = res->imax + 2; i <= imax; i += 2) {+      res->H[i] = sres_CreateChi2 ();+      res->M[i] = sres_CreateChi2 ();+      res->J[i] = sres_CreateChi2 ();+      res->R[i] = sres_CreateChi2 ();+      res->C[i] = sres_CreateChi2 ();+   }++   for (i = 0; i <= imax; i += 2) {+      L = i + L0;+      sres_InitChi2 (res->H[i], N, L, "");+      sres_InitChi2 (res->M[i], N, L, "");+      sres_InitChi2 (res->R[i], N, L, "");+      sres_InitChi2 (res->J[i], N, L, "");+      sres_InitChi2 (res->C[i], N, L, "");+      res->R[i]->jmax = L / 2;+      res->C[i]->jmax = L / 2;+   }+   res->L1 = L1;+   res->L0 = L0;+   res->imax = imax;+   res->work = work;+   res->name = util_Realloc (res->name, 1 + strlen (nam) * sizeof (char));+   strcpy (res->name, nam);+}+++/*-------------------------------------------------------------------------*/++static void Steps (+   unif01_Gen *gen, +   swalk_Res *res,+   long j,               /* will generate j-th random number */+   int r,                /* drop the first r bits of each random number */+   int s                 /* keep only s bits of each random number */+   )+/*+ * Generates a random number Z; each of the s bits of Z kept is a step of+ * the random walk. Updates all statistics for these s steps.+ */+{+   int i;+   long k;+   unsigned long Z, iBit;+   const unsigned long SBIT = 1UL << (s - 1);+   WorkType *work = res->work;++   Z = unif01_StripB (gen, r, s);+   iBit = SBIT;++   for (i = s - 1; i >= 0; i--) {+      ++res->L;+      if (Z & iBit)               /* If i bit of Z is 1 */+         work->X = 1;+      else+         work->X = -1;+      work->S += work->X;+      if (work->S > work->M)+         work->M = work->S;+      if (work->S == 0)+         ++work->R;+      if ((s * j - i) & 1) {+         if (work->S > 0)+            ++work->J;+         if (work->S * work->S_2 < 0)+            ++work->C;+         work->S_2 = work->S;+      }++      if ((res->L >= res->L0) && !(res->L & 1)) {+         k = res->L - res->L0;+         ++res->H[k]->Count[res->H[k]->Loc[(res->L + work->S) / 2]];+         ++res->M[k]->Count[res->M[k]->Loc[work->M]];+         ++res->J[k]->Count[res->J[k]->Loc[2 * work->J]];+         ++res->R[k]->Count[res->R[k]->Loc[work->R]];+         ++res->C[k]->Count[res->C[k]->Loc[work->C]];+      }+      iBit >>= 1;+   }+}+++/*-------------------------------------------------------------------------*/++void swalk_RandomWalk1 (unif01_Gen *gen, swalk_Res *res,+   long N, long n, int r, int s, long L0, long L1)+{+   swalk_rwType m;+   long DeltaL;+   int LMS;+   long LDS;+   long i, j, k, Rep, Seq;+   double khi;+   double V[1];               /* Number degrees of freedom for ChiSquare */+   long NbClasses;+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "swalk_RandomWalk1 test";+   WorkType work;+   sres_Chi2 *Q;++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataWalk1 (gen, TestName, N, n, r, s, L0, L1);++   util_Assert (L0 > 0,    "swalk_RandomWalk1:   L0 <= 0");+   util_Assert (!(L0 & 1), "swalk_RandomWalk1:   L0 must be even");+   util_Assert (!(L1 & 1), "swalk_RandomWalk1:   L1 must be even");+   util_Assert (L1 >= L0,  "swalk_RandomWalk1:   L0 > L1");+   util_Assert (r + s <= PREC, "swalk_RandomWalk1:   r + s > 32");+   if (n < 3.0 * gofs_MinExpected) {+      util_Warning (TRUE, "swalk_RandomWalk1:   n < 3*gofs_MinExpected");+      return;+   }++   DeltaL = L1 - L0;+   LDS = L1 / s;+   LMS = L1 % s;+   if (res == NULL) {+      localRes = TRUE;+      res = swalk_CreateRes ();+   }+   InitRes (res, &work, N, L0, L1, "swalk_RandomWalk1");++   /* Compute the expected numbers and merge classes for the ChiSquare */+   for (k = 0; k <= DeltaL; k += 2) {+      CalcNbExp (n, L0, k, res);++      for (m = 0; m < swalk_rw_N; m++) {+         switch (m) {+         case swalk_rwH:+            Q = res->H[k];+            break;+         case swalk_rwM:+            Q = res->M[k];+            break;+         case swalk_rwJ:+            Q = res->J[k];+            break;+         case swalk_rwR:+            Q = res->R[k];+            break;+         case swalk_rwC:+            Q = res->C[k];+            break;+         default:+            util_Error ("swalk_RandomWalk1:   no such case");+         }+         if (swrite_Classes) {+            if (L1 > L0) {+               printf ("===============================================\n");+               printf ("Walk of %3ld steps\n", L0 + k);+            }+            printf ("===============================================\nThe ");+            printf ("%s", swalk_rwName[m]);+            printf ("\n");+            gofs_WriteClasses (Q->NbExp, Q->Loc, Q->jmin, Q->jmax, 0);+         }+         gofs_MergeClasses (Q->NbExp, Q->Loc, &(Q->jmin), &(Q->jmax),+            &NbClasses);++         if (swrite_Classes) {+            gofs_WriteClasses (Q->NbExp, Q->Loc, Q->jmin, Q->jmax, NbClasses);+         }++         /* Set description for second level statistical collectors */+         sprintf (str, "The N statistic values (a ChiSquare with %ld degrees"+                       " of freedom) ", NbClasses - 1);+         statcoll_SetDesc (Q->sVal1, str);+         Q->degFree = NbClasses - 1;+      }+   }++   /* Beginning of test */+   for (Seq = 1; Seq <= N; Seq++) {++      /* Reset counters to zero for each sequence */+      for (k = 0; k <= DeltaL; k += 2) {+         for (i = res->H[k]->jmin; i <= res->H[k]->jmax; i++)+            res->H[k]->Count[i] = 0;+         for (i = res->R[k]->jmin; i <= res->R[k]->jmax; i++)+            res->R[k]->Count[i] = 0;+         for (i = res->J[k]->jmin; i <= res->J[k]->jmax; i++)+            res->J[k]->Count[i] = 0;+         for (i = res->M[k]->jmin; i <= res->M[k]->jmax; i++)+            res->M[k]->Count[i] = 0;+         for (i = res->C[k]->jmin; i <= res->C[k]->jmax; i++)+            res->C[k]->Count[i] = 0;+      }++      /* A ChiSquare sample of size n */+      for (Rep = 1; Rep <= n; Rep++) {+         work.S = 0;+         work.S_2 = 0;+         work.M = 0;+         work.R = 0;+         work.J = 0;+         work.C = 0;+         res->L = 0;++         /* One random walk of length L */+         for (j = 1; j <= LDS; j++)+            Steps (gen, res, j, r, s);+         /* the last LMS steps of L */+         if (LMS > 0)+            Steps (gen, res, LDS + 1, r, LMS);+      }++      for (k = 0; k <= DeltaL; k += 2) {+         khi = gofs_Chi2 (res->H[k]->NbExp, res->H[k]->Count, res->H[k]->jmin,+            res->H[k]->jmax);+         statcoll_AddObs (res->H[k]->sVal1, khi);+         khi = gofs_Chi2 (res->M[k]->NbExp, res->M[k]->Count, res->M[k]->jmin,+            res->M[k]->jmax);+         statcoll_AddObs (res->M[k]->sVal1, khi);+         khi = gofs_Chi2 (res->R[k]->NbExp, res->R[k]->Count, res->R[k]->jmin,+            res->R[k]->jmax);+         statcoll_AddObs (res->R[k]->sVal1, khi);+         khi = gofs_Chi2 (res->J[k]->NbExp, res->J[k]->Count, res->J[k]->jmin,+            res->J[k]->jmax);+         statcoll_AddObs (res->J[k]->sVal1, khi);+         khi = gofs_Chi2 (res->C[k]->NbExp, res->C[k]->Count, res->C[k]->jmin,+            res->C[k]->jmax);+         statcoll_AddObs (res->C[k]->sVal1, khi);+         if (swrite_Counters)+            WriteDetailsWalk (res, k, n);+      }+   }++   for (k = 0; k <= DeltaL; k += 2) {+      for (m = 0; m < swalk_rw_N; m++) {+         switch (m) {+         case swalk_rwH:+            Q = res->H[k];+            break;+         case swalk_rwM:+            Q = res->M[k];+            break;+         case swalk_rwJ:+            Q = res->J[k];+            break;+         case swalk_rwR:+            Q = res->R[k];+            break;+         case swalk_rwC:+            Q = res->C[k];+            break;+         default:+            util_Error ("swalk_RandomWalk1:   no such case2");+         }+         V[0] = Q->degFree;+         Q->pVal1->NObs = Q->sVal1->NObs;+         gofw_ActiveTests2 (Q->sVal1->V, Q->pVal1->V, N, wdist_ChiSquare,+            V, Q->sVal2, Q->pVal2);+         sres_GetChi2SumStat (Q);+     }+   }++   if (swrite_Basic) {+      WriteResultWalk (res, N);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      swalk_DeleteRes (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataWalk1a (unif01_Gen *gen, char *TestName,+   long N, long n, int r, int s, int t, long L, bitset_BitSet maskc)+{+   int i;++   swrite_Head (gen, TestName, N, n, r);+   printf (",   s = %1d,  t =  %1d,   L = %1ld\n\n", s, t, L);+   printf ("   C = { ");++   util_Assert (t <= 31, "swalk_RandomWalk1a:   t > 31");+   for (i = 0; i < t; i++) {+      if (bitset_TestBit (maskc, i)) {+         printf ("%1d", i);+         if (i < t - 1)+            printf (", ");+      }+   }+   printf (" }\n\n\n");+}+++/*-------------------------------------------------------------------------*/++void swalk_RandomWalk1a (unif01_Gen *gen, swalk_Res *res,+   long N, long n, int r, int s, int t, long L, bitset_BitSet maskc)+{+   swalk_rwType m;+   long z2, z1, y;+   long C, J, R, M, S_2, S, X;    /* Statistics */+   long i, j, pas, Rep, Seq;      /* Indices */+   bitset_BitSet ens;+   double khi;                    /* ChiSquare value */+   double V[1];                   /* Number deg. of freedom for ChiSquare */+   long NbClasses;+   char str[LENGTH + 1];+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "swalk_RandomWalk1a test";+   sres_Chi2 *Q;++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataWalk1a (gen, TestName, N, n, r, s, t, L, maskc);++   util_Assert (!(L & 1), "swalk_RandomWalk1a:   L is odd");+   util_Assert (L > 0, "swalk_RandomWalk1a:   L <= 0");+   util_Assert (r + s <= PREC, "swalk_RandomWalk1a:   r + s > 32");+   util_Assert (s <= PREC, "swalk_RandomWalk1a:   s > 32");+   if (n < 3.0 * gofs_MinExpected) {+      util_Warning (TRUE, "swalk_RandomWalk1a:   n < 3*gofs_MinExpected");+      return;+   }+   if (res == NULL) {+      localRes = TRUE;+      res = swalk_CreateRes ();+   }+   InitRes (res, NULL, N, L, L, "swalk_RandomWalk1a");++   /* Compute the expected numbers */+   CalcNbExp (n, L, 0, res);++   /* Merge classes for the ChiSquare */+   for (m = 0; m < swalk_rw_N; m++) {+      switch (m) {+      case swalk_rwH:+         Q = res->H[0];+         break;+      case swalk_rwM:+         Q = res->M[0];+         break;+      case swalk_rwJ:+         Q = res->J[0];+         break;+      case swalk_rwR:+         Q = res->R[0];+         break;+      case swalk_rwC:+         Q = res->C[0];+         break;+      default:+         util_Error ("swalk_RandomWalk1a:   no such case");+      }+      if (swrite_Classes) {+         printf ("===============================================\nThe ");+         printf ("%s", swalk_rwName[m]);+         printf ("\n");+         gofs_WriteClasses (Q->NbExp, Q->Loc, Q->jmin, Q->jmax, 0);+      }+      gofs_MergeClasses (Q->NbExp, Q->Loc, &(Q->jmin), &(Q->jmax), &NbClasses);++      if (swrite_Classes)+         gofs_WriteClasses (Q->NbExp, Q->Loc, Q->jmin, Q->jmax, NbClasses);++      /* Set description for second level statistical collectors */+      sprintf (str, "The N statistic values (a ChiSquare with %ld degrees of"+                    " freedom) ", NbClasses - 1);+      statcoll_SetDesc (Q->sVal1, str);+      Q->degFree = NbClasses - 1;+   }++   /* Generate the first t bits */+   z1 = 0;+   for (i = 0; i <= (t - 1) / s; i++) {+      z2 = unif01_StripB (gen, r, s);+      for (j = 1; j <= s; j++) {+         z1 = 2 * z1 + (z2 & 1);+         z2 /= 2;+      }+   }+   j = 0;+   z2 = unif01_StripB (gen, r, s);++   /* Beginning of test */+   for (Seq = 1; Seq <= N; Seq++) {++      /* Reset counters to zero for each sequence */+      for (i = res->H[0]->jmin; i <= res->H[0]->jmax; i++)+         res->H[0]->Count[i] = 0;+      for (i = res->R[0]->jmin; i <= res->R[0]->jmax; i++)+         res->R[0]->Count[i] = 0;+      for (i = res->J[0]->jmin; i <= res->J[0]->jmax; i++)+         res->J[0]->Count[i] = 0;+      for (i = res->M[0]->jmin; i <= res->M[0]->jmax; i++)+         res->M[0]->Count[i] = 0;+      for (i = res->C[0]->jmin; i <= res->C[0]->jmax; i++)+         res->C[0]->Count[i] = 0;++      for (Rep = 1; Rep <= n; Rep++) {+         C = J = R = M = S_2 = S = 0;+         pas = 0;++         /* Generate a random walk of L steps */+         do {+            do {+               ++pas;+               ++j;+               z1 = 2 * z1 + (z2 & 1);+               z2 /= 2;+               ens = maskc & z1;+               y = 0;+               for (i = 0; i < t; i++) {+                  if (bitset_TestBit (ens, i))+                     ++y;+               }+               if (y & 1)+                  X = 1;+               else+                  X = -1;+               S += X;+               if (S > M)+                  M = S;+               if (S == 0)+                  ++R;+               if (pas & 1) {+                  if (S > 0)+                     ++J;+                  if (S * S_2 < 0)+                     ++C;+                  S_2 = S;+               }+            } while (!(j == s || pas == L));+            if (j == s) {+               j = 0;+               z2 = unif01_StripB (gen, r, s);+            }+         } while (pas != L);++         /* Update counters */+         ++res->H[0]->Count[res->H[0]->Loc[(L + S) / 2]];+         ++res->M[0]->Count[res->M[0]->Loc[M]];+         ++res->J[0]->Count[res->J[0]->Loc[2 * J]];+         ++res->R[0]->Count[res->R[0]->Loc[R]];+         ++res->C[0]->Count[res->C[0]->Loc[C]];+      }++      khi = gofs_Chi2 (res->H[0]->NbExp, res->H[0]->Count, res->H[0]->jmin,+         res->H[0]->jmax);+      statcoll_AddObs (res->H[0]->sVal1, khi);+      khi = gofs_Chi2 (res->M[0]->NbExp, res->M[0]->Count, res->M[0]->jmin,+         res->M[0]->jmax);+      statcoll_AddObs (res->M[0]->sVal1, khi);+      khi = gofs_Chi2 (res->R[0]->NbExp, res->R[0]->Count, res->R[0]->jmin,+         res->R[0]->jmax);+      statcoll_AddObs (res->R[0]->sVal1, khi);+      khi = gofs_Chi2 (res->J[0]->NbExp, res->J[0]->Count, res->J[0]->jmin,+         res->J[0]->jmax);+      statcoll_AddObs (res->J[0]->sVal1, khi);+      khi = gofs_Chi2 (res->C[0]->NbExp, res->C[0]->Count, res->C[0]->jmin,+         res->C[0]->jmax);+      statcoll_AddObs (res->C[0]->sVal1, khi);++      if (swrite_Counters)+         WriteDetailsWalk (res, 0, n);+   }++   for (m = 0; m < swalk_rw_N; m++) {+      switch (m) {+      case swalk_rwH:+         Q = res->H[0];+         break;+      case swalk_rwM:+         Q = res->M[0];+         break;+      case swalk_rwJ:+         Q = res->J[0];+         break;+      case swalk_rwR:+         Q = res->R[0];+         break;+      case swalk_rwC:+         Q = res->C[0];+         break;+      default:+         util_Error ("swalk_RandomWalk1a:   no such case2");+      }+      V[0] = Q->degFree;+      Q->pVal1->NObs = Q->sVal1->NObs;+      gofw_ActiveTests2 (Q->sVal1->V, Q->pVal1->V, N, wdist_ChiSquare, V,+                         Q->sVal2, Q->pVal2);+      sres_GetChi2SumStat (Q);+   }++   if (swrite_Basic) {+      WriteResultWalk (res, N);+      swrite_Final (gen, Timer);+   }+   if (localRes)+      swalk_DeleteRes (res);+   chrono_Delete (Timer);+}+++/*=========================================================================*/++static void WriteDataGeo (unif01_Gen *gen, char *TestName, +   long N, long n, int r, double Mu, swalk_AlgoType Algo)+{+   swrite_Head (gen, TestName, N, n, r);+   printf (",   Mu = %10.8f,   Algo = ", Mu);+   if (Algo == swalk_AlgoP)+      printf ("AlgoP\n\n");+   else+      printf ("AlgoN\n\n");+   printf ("   Expected length of a walk = %14.2f\n\n\n", 1.0 / (1.0 - Mu));+}+++/*-------------------------------------------------------------------------*/++static void WriteNbExpCount (sres_Chi2 *res, double Prob[])+/* + * Writes the expected numbers, the observed numbers, and the normalized+ * values in swalk_VarGeo.+ */+{+   long L;+   double Ecart;+   double y;++   printf ("--------------------------------------------------\n"+      "Length  NumExpected  NumObserved  Normalized value\n\n");+   for (L = res->jmin; L < res->jmax; L = res->Loc[L + 1]) {+      printf ("%4ld %14.2f %10ld ", L, res->NbExp[L], res->Count[L]);+      Ecart = sqrt (res->NbExp[L] * (1.0 - Prob[L]));+      y = (res->Count[L] - res->NbExp[L]) / Ecart;+      printf ("%14.2f\n", y);+   }+   L = res->jmax;+   printf ("%4ld %14.2f %10ld ", L, res->NbExp[L], res->Count[L]);+   Ecart = sqrt (res->NbExp[L] * (1.0 - Prob[L]));+   y = (res->Count[L] - res->NbExp[L]) / Ecart;+   printf ("%14.2f\n\n\n", y);+}+++/*-------------------------------------------------------------------------*/++static void AlgorithmP (unif01_Gen *gen, sres_Chi2 *res, double Prob[],+   long N, long n, int r, double Mu)+{+   long j;+   long L;+   long Seq;+   double X;+   double U;++   for (Seq = 1; Seq <= N; Seq++) {+      for (L = res->jmin; L <= res->jmax; L++)+         res->Count[L] = 0;++      for (j = 1; j <= n; j++) {+         L = 1;+         U = unif01_StripD (gen, r);+         while (U < Mu) {+            ++L;+            U = unif01_StripD (gen, r);+         }+         if (L >= res->jmax)+            ++res->Count[res->Loc[res->jmax]];+         else+            ++res->Count[res->Loc[L]];+      }+      if (swrite_Counters)+         WriteNbExpCount (res, Prob);++      X = gofs_Chi2 (res->NbExp, res->Count, res->jmin, res->jmax);+      statcoll_AddObs (res->sVal1, X);+   }+}+++/*-------------------------------------------------------------------------*/++static void AlgorithmN (unif01_Gen *gen, sres_Chi2 *res, double Prob[],+   long N, long n, int r, double Mu)+{+   long j;+   long L;+   long Seq;+   double X;+   double U;++   Mu = 1.0 - Mu;+   for (Seq = 1; Seq <= N; Seq++) {+      for (L = res->jmin; L <= res->jmax; L++)+         res->Count[L] = 0;++      for (j = 1; j <= n; j++) {+         L = 1;+         U = unif01_StripD (gen, r);+         while (U >= Mu) {+            ++L;+            U = unif01_StripD (gen, r);+         }+         if (L >= res->jmax)+            ++res->Count[res->Loc[res->jmax]];+         else+            ++res->Count[res->Loc[L]];+      }+      if (swrite_Counters)+         WriteNbExpCount (res, Prob);++      X = gofs_Chi2 (res->NbExp, res->Count, res->jmin, res->jmax);+      statcoll_AddObs (res->sVal1, X);+   }+}+++/*-------------------------------------------------------------------------*/++static void swalk_VarGeo (unif01_Gen *gen, sres_Chi2 *res,+   long N, long n, int r, double Mu, swalk_AlgoType Algo)+{+   const double epsilon = 1.0E-10;+   long L;+   double nLR = n;+   double V[1];                /* Number degrees of freedom for ChiSquare */+   char str[LENGTH + 1];+   long tt;+   long NbClasses;+   lebool localRes = FALSE;+   chrono_Chrono *Timer;+   char *TestName = "swalk_VarGeo test";+   double *Prob;++   Timer = chrono_Create ();+   if (swrite_Basic)+      WriteDataGeo (gen, TestName, N, n, r, Mu, Algo);++   util_Assert (r < PREC, "swalk_VarGeo:   r > 52");+   util_Assert (Mu > 0.0 && Mu < 1.0, "swalk_VarGeo:   Mu not in (0,1)");++   /* We consider only the terms of the geometric law with */+   /* probability > epsilon */+   tt = 1 + (log (epsilon) - num2_log1p (-Mu)) / log (Mu);+   Prob = util_Calloc (1 + (size_t) tt, sizeof (double));++   /* The probabilities and the expected numbers: NbExp = n*Prob */+   Prob[1] = 1.0 - Mu;+   for (L = 1; L <= tt - 2; L++)+      Prob[L + 1] = Mu * Prob[L];+   Prob[tt] = fbar_Geometric (1.0 - Mu, tt);++   if (res == NULL) {+      localRes = TRUE;+      res = sres_CreateChi2 ();+   }+   sres_InitChi2 (res, N, tt, "swalk_VarGeo");++   for (L = 1; L <= tt; L++)+      res->NbExp[L] = nLR * Prob[L];++   res->jmin = 1;+   res->jmax = tt;+   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, res->Loc, res->jmin, res->jmax, 0);+   gofs_MergeClasses (res->NbExp, res->Loc, &res->jmin, &res->jmax,+                      &NbClasses);+   if (swrite_Classes)+      gofs_WriteClasses (res->NbExp, res->Loc, res->jmin, res->jmax,+                         NbClasses);++   sprintf (str, "The N statistic values (a ChiSquare with %1ld degrees"+                 " of freedom):", NbClasses - 1);+   statcoll_SetDesc (res->sVal1, str);+   res->degFree = NbClasses - 1;+   if (res->degFree < 1) {+      if (localRes)+         sres_DeleteChi2 (res);+      return;+   }++   if (Algo == swalk_AlgoP)+      AlgorithmP (gen, res, Prob, N, n, r, Mu);+   else+      AlgorithmN (gen, res, Prob, N, n, r, Mu);++   V[0] = res->degFree;+   res->pVal1->NObs = N;+   gofw_ActiveTests2 (res->sVal1->V, res->pVal1->V, N, wdist_ChiSquare, V,+                      res->sVal2, res->pVal2);+   sres_GetChi2SumStat (res);++   if (swrite_Collectors)+      statcoll_Write (res->sVal1, 5, 14, 4, 3);++   if (swrite_Basic) {+      swrite_AddStrChi (str, LENGTH, res->degFree);+      gofw_WriteActiveTests2 (N, res->sVal2, res->pVal2, str);+      swrite_Chi2SumTest (N, res);+      swrite_Final (gen, Timer);+   }+   util_Free (Prob);+   if (localRes)+      sres_DeleteChi2 (res);+   chrono_Delete (Timer);+}+++/*-------------------------------------------------------------------------*/++void swalk_VarGeoP (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, double Mu)+{+   swalk_VarGeo (gen, res, N, n, r, Mu, swalk_AlgoP);+}++/*-------------------------------------------------------------------------*/++void swalk_VarGeoN (unif01_Gen * gen, sres_Chi2 * res,+   long N, long n, int r, double Mu)+{+   swalk_VarGeo (gen, res, N, n, r, Mu, swalk_AlgoN);+}
+ cbits/testu/src/swrite.c view
@@ -0,0 +1,167 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           swrite.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/+++#include "gdef.h"+#include "util.h"+#include "chrono.h"++#include "swrite.h"+#include "unif01.h"+#include "gofw.h"++#include <string.h>+#include <stdio.h>+#include <math.h>++++#define LEN 100+++lebool swrite_Basic = TRUE;+lebool swrite_Parameters = FALSE;+lebool swrite_Collectors = FALSE;+lebool swrite_Counters = FALSE;+lebool swrite_Classes = FALSE;+lebool swrite_Others = FALSE;++lebool swrite_Host = TRUE;++char swrite_ExperimentName[LEN + 1] = "";++++/*=========================================================================*/++void swrite_SetExperimentName (char Name[])+{+   strncpy (swrite_ExperimentName, Name, (size_t) LEN);+}+++/*=========================================================================*/++void swrite_Head (unif01_Gen *gen, char *TestName, long N, long n, int r)+{+   printf ("***********************************************************\n");+   printf ("HOST = ");+   if (swrite_Host) {+      gdef_WriteHostName ();+      printf ("\n");+   } else+      printf ("\n\n");+   util_Assert (gen != NULL, "No generator has been created");+   unif01_WriteNameGen (gen);+   printf ("\n");+   if (swrite_ExperimentName && strcmp (swrite_ExperimentName, "")) {+      printf ("%s", swrite_ExperimentName);+      printf (":\n\n");+   }+   printf ("%s", TestName);+   printf (":\n-----------------------------------------------\n");+   printf ("   N = %2ld,  n = %2ld,  r = %2d", N, n, r);+   util_Assert (N > 0, "   N <= 0");+   util_Assert (n > 0, "   n <= 0");+   util_Assert (r >= 0, "   r < 0");+}+++/*=========================================================================*/++void swrite_Final (unif01_Gen *gen, chrono_Chrono *Timer)+{+   printf ("-----------------------------------------------\n");+   printf ("CPU time used                    :  ");+   chrono_Write (Timer, chrono_hms);+   printf ("\n");+   unif01_WriteState (gen);+   printf ("\n\n\n");+}+++/*=========================================================================*/++void swrite_AddStrChi (char S[], int len, long d)+{+   char str[31];+   int j;+   strncpy (S, "Number of degrees of freedom          : ", len);+   j = strlen (S);+   util_Assert (len > j, "swrite_AddStrChi:   len <= j");+   sprintf (str, "%4ld", d);+   strncat (S, str, len - j);+   j = strlen (S);+   util_Assert (len > j, "swrite_AddStrChi *:   len <= j");+   strncat (S, "\nChi-square statistic                  :", len - j);+   S[len - 1] = '\0';+}+++/*=========================================================================*/++void swrite_NormalSumTest (long N, sres_Basic *res)+{+   if (N <= 1)+      return;+   printf ("Tests on the sum of all N observations\n");+   printf ("Standardized normal statistic         :");+   gofw_Writep2 (res->sVal2[gofw_Sum]/sqrt((double)N), res->pVal2[gofw_Sum]);+   printf ("Sample variance                       :");+   gofw_Writep2 (res->sVal2[gofw_Var], res->pVal2[gofw_Var]);+}+++/*=========================================================================*/+#define LENGTH 200++void swrite_Chi2SumTest (long N, sres_Chi2 *res)+{+   char str[LENGTH + 1];+   if (N <= 1)+      return;+   printf ("Test on the sum of all N observations\n");+   swrite_AddStrChi (str, LENGTH, N*res->degFree);+   gofw_Writep2 (res->sVal2[gofw_Sum], res->pVal2[gofw_Sum]);+}+++/*=========================================================================*/++void swrite_Chi2SumTestb (long N, double sval, double pval, long degFree)+{+   char str[LENGTH + 1];+   if (N <= 1)+      return;+   printf ("Test on the sum of all N observations\n");+   swrite_AddStrChi (str, LENGTH, N*degFree);+   gofw_Writep2 (sval, pval);+}+
+ cbits/testu/src/tables.c view
@@ -0,0 +1,504 @@+/*************************************************************************\+ *+ * Package:        MyLib+ * File:           tables.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/+++#include "tables.h"+#include "util.h"+#include "mystr.h"+#include "num.h"++#include <stdlib.h>+#include <stdio.h>+#include <math.h>+#include <string.h>+++++++tables_StyleType Style = tables_Plain;++static char OuvrantMat = ' ';     /* Matrix delimitors */+static char FermantMat = ' ';++static char OuvrantVec = ' ';     /* Vector delimitors */+static char FermantVec = ' ';++static char SepareVec = ' ';      /* Element separators */+static char SepareElem = ' ';++#define MaxInd 60+static long HacheTab[MaxInd + 1] = {+   8191, 12109, 16381, 24373, 32749, 48871, 65521, 97777, 131071, 195659,+   262139, 393203, 524287, 786407, 1048573, 1572803, 2097143, 2500097,+   3145711, 3600097, 4194301, 5300003, 6291403, 7300003, 8388593, 9500021,+   10500013, 11500003, 12582917, 13500007, 14500001, 15500011, 16777213,+   17500013, 18500017, 19500101, 20500097, 21300101, 22200001,+   23200097, 24200101, 25165807, 28000097, 30000001, 33554393, 39000001,+   45000097, 50331653, 55000013, 61000001, 67108859, 76000091, 85000007,+   94906247, 134217689, 189812501, 268435399, 379625003, 2147483647, -1+};+++long **tables_CreateMatrixL (int N, int M)+{+   int i;+   long **T1;+   /* Note: the memory must be allocated in a contiguous way for the matrix+      to be later used properly, without problems. Source: comp.lang.c -+      Answers to Frequently Asked Questions+      http://www.faqs.org/faqs/C-faq/faq/ Questions 6.18, 6.19, 6.20 */++   T1 = (long **) util_Malloc (N * sizeof (long *));+   T1[0] = (long *) util_Malloc (N * M * sizeof (long));+   for (i = 1; i < N; i++)+      T1[i] = T1[0] + i * M;+   return T1;+}+++unsigned long **tables_CreateMatrixUL (int N, int M)+{+   int i;+   unsigned long **T3;++   T3 = (unsigned long **) util_Malloc (N * sizeof (unsigned long *));+   T3[0] = (unsigned long *) util_Malloc (N * M * sizeof (unsigned long));+   for (i = 1; i < N; i++)+      T3[i] = T3[0] + i * M;+   return T3;+}+++double **tables_CreateMatrixD (int N, int M)+{+   int i;+   double **T2;++   T2 = (double **) util_Malloc (N * sizeof (double *));+   T2[0] = (double *) util_Malloc (N * M * sizeof (double));+   for (i = 1; i < N; i++)+      T2[i] = T2[0] + i * M;+   return T2;+}+++void tables_DeleteMatrixL (long ***T)+{+   free ((*T)[0]);+   free (*T);+   *T = NULL;+}++void tables_DeleteMatrixUL (unsigned long ***T)+{+   free ((*T)[0]);+   free (*T);+   *T = NULL;+}++void tables_DeleteMatrixD (double ***T)+{+   free ((*T)[0]);+   free (*T);+   *T = NULL;+}+++void tables_CopyTabD (double T1[], double T2[], int n1, int n2)+{+   int i;+   for (i = n1; i <= n2; i++) {+      T2[i] = T1[i];+   }+}++void tables_CopyTabL (long T1[], long T2[], int n1, int n2)+{+   int i;+   for (i = n1; i <= n2; i++) {+      T2[i] = T1[i];+   }+}++void tables_QuickSortD (double T[], int l, int r)+   /* On trie le tableau des observations T[l..r].  */+{+   int j;                         /* Indices dans le tableau Tab.  */+   int i;+   double w;+   double x;+   i = l;+   j = r;+   x = T[(l + r) / 2];+   do {+      while (T[i] < x)+         ++i;+      while (x < T[j])+         --j;+      if (i <= j) {+         w = T[i];+         T[i] = T[j];+         T[j] = w;+         ++i;+         --j;+      }+   } while (i <= j);+   if (l < j)+      tables_QuickSortD (T, l, j);+   if (i < r)+      tables_QuickSortD (T, i, r);+}+++void tables_QuickSortL (long T[], int l, int r)+     /* On trie le tableau des observations T[l..r].  */+{+   int j;                         /* Indices dans le tableau Tab.  */+   int i;+   long w;+   long x;+   i = l;+   j = r;+   x = T[(l + r) / 2];+   do {+      while (T[i] < x)+         ++i;+      while (x < T[j])+         --j;+      if (i <= j) {+         w = T[i];+         T[i] = T[j];+         T[j] = w;+         ++i;+         --j;+      }+   } while (i <= j);+   if (l < j)+      tables_QuickSortL (T, l, j);+   if (i < r)+      tables_QuickSortL (T, i, r);+}+++/*=======================================================================*/+#ifdef USE_LONGLONG++void tables_QuickSortLL (longlong T[], int l, int r)+{+   int j;+   int i;+   longlong w;+   longlong x;+   i = l;+   j = r;+   x = T[(l + r) / 2];+   do {+      while (T[i] < x)+         ++i;+      while (x < T[j])+         --j;+      if (i <= j) {+         w = T[i];+         T[i] = T[j];+         T[j] = w;+         ++i;+         --j;+      }+   } while (i <= j);+   if (l < j)+      tables_QuickSortLL (T, l, j);+   if (i < r)+      tables_QuickSortLL (T, i, r);+}++void tables_QuickSortULL (ulonglong T[], int l, int r)+{+   int j;+   int i;+   ulonglong w;+   ulonglong x;+   i = l;+   j = r;+   x = T[(l + r) / 2];+   do {+      while (T[i] < x)+         ++i;+      while (x < T[j])+         --j;+      if (i <= j) {+         w = T[i];+         T[i] = T[j];+         T[j] = w;+         ++i;+         --j;+      }+   } while (i <= j);+   if (l < j)+      tables_QuickSortULL (T, l, j);+   if (i < r)+      tables_QuickSortULL (T, i, r);+}++#endif+/*=======================================================================*/++void tables_WriteTabL (long V[], int n1, int n2, int k, int p, char Desc[])+{+   int i;+   printf ("---------------------------------------\n");+   printf ("%s\n", Desc);+   if (k > 1) {+      printf ("Elements  %d  to  %d\n\n", n1, n2);+      for (i = n1; i <= n2; i++) {+         printf ("%*ld ", p, V[i]);+         if (((i + 1 - n1) % k) == 0)+            printf ("\n");+      }+      printf ("\n");+   } else {+      printf ("\n Index        Element\n");+      for (i = n1; i <= n2; i++)+         printf ("%6d   %12ld\n", i, V[i]);+   }+   printf ("\n");+}+++void tables_WriteTabD (double V[], int n1, int n2, int k, int p1,+   int p2, int p3, char Desc[])+{+   int i;+   printf ("---------------------------------------\n");+   printf ("%s\n", Desc);+   if (k > 1) {+      printf ("Elements  %d  to  %d\n\n", n1, n2);+      for (i = n1; i <= n2; i++) {+         /* printf ("%*.*G", p1, p2, V[i]); */+         num_WriteD (V[i], p1, p2, p3);+         if (((i + 1 - n1) % k) == 0)+            printf ("\n");+      }+      printf ("\n");+   } else {+      printf ("\n Index            Element\n");+      for (i = n1; i <= n2; i++) {+         printf ("%6d", i);+         num_WriteD (V[i], p1, p2, p3);+         printf ("\n");+      }+   }+   printf ("\n");+}+++/*=========================================================================*/+#ifdef USE_LONGLONG++void tables_WriteTabLL (longlong V[], int n1, int n2, int k, int p,+    char Desc[])+{+   int i;+   printf ("---------------------------------------\n");+   printf ("%s\n", Desc);+   if (k > 1) {+      printf ("Elements  %d  to  %d\n\n", n1, n2);+      for (i = n1; i <= n2; i++) {+         printf (" %*" PRIdLEAST64, p, V[i]);+         if (((i + 1 - n1) % k) == 0)+            printf ("\n");+      }+      printf ("\n");+   } else {+      printf ("\n Index        Element\n");+      for (i = n1; i <= n2; i++)+         printf ("%6d     %12" PRIdLEAST64 "\n", i, V[i]);+   }+   printf ("\n");+}++void tables_WriteTabULL (ulonglong V[], int n1, int n2, int k, int p,+    char Desc[])+{+   int i;+   printf ("---------------------------------------\n");+   printf ("%s\n", Desc);+   if (k > 1) {+      printf ("Elements  %d  to  %d\n\n", n1, n2);+      for (i = n1; i <= n2; i++) {+         printf (" %*" PRIuLEAST64, p, V[i]);+         if (((i + 1 - n1) % k) == 0)+            printf ("\n");+      }+      printf ("\n");+   } else {+      printf ("\n Index        Element\n");+      for (i = n1; i <= n2; i++)+         printf ("%6d     %12" PRIuLEAST64 "\n", i, V[i]);+   }+   printf ("\n");+}++#endif+/*=========================================================================*/+++static void FixeDelim (tables_StyleType style)+{+   /* Fixe les delimiteurs pour imprimer une matrice selon un format+      approprie */+   Style = style;+   switch (style) {+   case tables_Mathematica:+      OuvrantMat = '{';+      FermantMat = '}';+      OuvrantVec = '{';+      FermantVec = '}';+      SepareVec = ',';+      SepareElem = ',';+      break;+   case tables_Matlab:+      OuvrantMat = '[';+      FermantMat = ']';+      OuvrantVec = ' ';+      FermantVec = ' ';+      SepareVec = ' ';+      SepareElem = ' ';+      break;+   default:+      OuvrantMat = ' ';+      FermantMat = ' ';+      OuvrantVec = ' ';+      FermantVec = ' ';+      SepareVec = ' ';+      SepareElem = ' ';+      break;+   }+}+++void tables_WriteMatrixL (long **Mat, int i1, int i2, int j1, int j2,+   int w, tables_StyleType style, char Nom[])+{+   int i;+   int j;++   FixeDelim (style);+   if (strlen (Nom) > 0) {+      printf ("%s = ", Nom);+   }+   printf ("%c\n", OuvrantMat);+   for (i = i1; i <= i2; i++) {+      printf ("%c", OuvrantVec);+      for (j = j1; j <= j2; j++) {+         printf ("%*ld", (int) w, Mat[i][j]);+         if (j < j2)+            printf ("%c", SepareElem);+      }+      printf ("%c", FermantVec);+      if (i < i2)+         printf ("%c\n", SepareVec);+   }+   printf ("%c\n\n", FermantMat);+}+++void tables_WriteMatrixD (double **Mat, int i1, int i2, int j1, int j2,+   int w, int p, tables_StyleType style, char Nom[])+{+   int k;+   int m;+   int j;+   int i;+   unsigned int bidon;+   double prec;+   double x;+   int trouve;+   char S[32];++   FixeDelim (style);+   if (strlen (Nom) > 0) {+      printf ("%s = ", Nom);+   }+   prec = pow (10.0, (double) p);+   printf ("%c\n", OuvrantMat);+   for (i = i1; i <= i2; i++) {+      printf ("%c", OuvrantVec);+      for (j = j1; j <= j2; j++) {+         printf (" ");+         switch (style) {+         case tables_Mathematica:+            x = Mat[i][j];+            if (((x != 0.0) && (fabs (x) < 0.1)) || (fabs (x) > prec)) {+               sprintf (S, "%.*G", (int) p, x);+               /* automatique avec %G ... : myst_Subst(S, "e", "E"); */+               mystr_Position ("E", S, 0, &bidon, &trouve);+               if (trouve) {+                  mystr_Subst (S, "E", "*10^(");+                  strncat (S, ")", (size_t) 2);+               }+            } else+               sprintf (S, "%.*f", (int) p, x);+            m = (int) strlen (S);+            for (k = 1; k <= w - m; k++) {+               printf (" ");+            }+            printf ("%s", S);+            break;+         default:+            /* tables_Matlab, Default */+            printf ("%*.*G", (int) w, (int) p, Mat[i][j]);+            break;+         }+         if (j < j2)+            printf ("%c", SepareElem);+      }+      printf ("%c", FermantVec);+      if (i < i2)+         printf ("%c\n", SepareVec);+   }+   printf ("%c\n\n", FermantMat);+}++long tables_HashPrime (long n, double load)+{+   int i;+   double nD;+   util_Assert (n > 0, "tables_HashPrime : n <= 0");+   nD = (double) n;+   i = 1;+   while (i < MaxInd && HacheTab[i] < n)+      ++i;+   while (i < MaxInd && load * (double) (HacheTab[i]) < nD)+      ++i;+   util_Assert (HacheTab[i] > 0, "tables_HashPrime failed");+   return HacheTab[i];+}
+ cbits/testu/src/ufile.c view
@@ -0,0 +1,371 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           ufile.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "gdef.h"+#include "util.h"+#include "ufile.h"+#include "unif01.h"++#include <stdio.h>+#include <string.h>+#include <limits.h>++/* Length of strings */+#define LEN 200++#define NORM32 2.3283064365386962E-10   /* 1 / 2^32 */++#define ARRAYDIM 1048576             /* = 2^20 */+++++/*========================== module variables ============================*/++static char S[LEN + 1];++static FILE *f1, *f2;++static int co1 = 0, co2 = 0;      /* Counters */++/* X1 will contain the numbers read from a text input file */+static double *X1 = NULL;++/* X2 will keep the bytes read from a binary input file */+static unsigned char *X2 = NULL;++static unsigned long n1, n2,      /* Current index of tables */+   MaxBin, MaxText,               /* Maximal index in the tables */+   Dim1, Dim2;                    /* Dimension of tables */++static double NBin, NText; /* Number of calls to the generator */++++/*========================================================================*/++static void WrReadText (void *junk)+{+   printf (" %.0f  numbers have been read\n", NText);+}++/*-----------------------------------------------------------------------*/++static void FillTextArray (void)+/*+ * Read numbers (double's) until end of file or until Dim1 (dimension of+ * array X1) numbers have been read. + */+/*+ * The standard function setvbuf could be used here to increase the+ * speed of reading. Right now, we use default system buffering.+ */+{+   unsigned long i;++   MaxText = Dim1;+   i = 0;+   while ((i < Dim1) && (fscanf (f1, " %lf", (X1 + i)) == 1))+      ++i;++   if (i < MaxText)+      /* The numbers do not fill the whole array: EOF or Error */+      MaxText = i;++   n1 = 0;+}++/*-----------------------------------------------------------------------*/++static double ReadText_U01 (void *junk1, void *junk2)+/*+ * Return the n-th element of the array. If at end of array, call+ * FillTextArray to fill the array once again, and then return the+ * first element.+ */+{+   if (n1 < MaxText) {+      NText += 1.0;+      return X1[n1++];++   } else if (MaxText == Dim1) {+      FillTextArray ();+      NText += 1.0;+      return X1[n1++];++   } else {+      X1 = util_Free (X1);+      util_Fclose (f1);+      sprintf (S, "%.0f numbers have been read.\n", NText);+      strncat (S, "End-of-file detected.\n", (size_t) 25);+      strncat (S, "Not enough numbers in file for these test parameters.",+                 (size_t) 60);+      util_Error (S);+      return -1.0;+   }+}++/*-----------------------------------------------------------------------*/++static unsigned long ReadText_Bits (void *vpar, void *vsta)+{+   return (unsigned long) (ReadText_U01 (vpar, vsta) * unif01_NORM32);+}++/*-----------------------------------------------------------------------*/++unif01_Gen * ufile_CreateReadText (char *A, long dim)+{+   unif01_Gen *gen;+   size_t leng;+   char name[LEN + 1];++   util_Assert (dim > 0, "ufile_CreateReadText:   nbuf <= 0.");+   util_Assert (co1 == 0,+      "ufile_CreateReadText:   only 1 generator at a time can be in use");+   co1++;++   gen = util_Malloc (sizeof (unif01_Gen));++   strncpy (name, "ufile_CreateReadText:   ", (size_t) LEN);+   strncat (name, A, (size_t) (LEN - 30));+   leng = strlen (name);+   gen->name = util_Calloc (leng + 1, sizeof (char));+   strncpy (gen->name, name, leng);++   f1 = util_Fopen (A, "r");+   Dim1 = util_Min (ARRAYDIM, dim);+   MaxText = Dim1;+   X1 = util_Calloc ((size_t) Dim1, sizeof (double));+   gen->GetBits = &ReadText_Bits;+   gen->GetU01 = &ReadText_U01;+   gen->Write = &WrReadText;+   gen->param = NULL;+   gen->state = NULL;+   FillTextArray ();+   NText = 0;+   return gen;+}++/*-----------------------------------------------------------------------*/++void ufile_DeleteReadText (unif01_Gen *gen)+{+   X1 = util_Free (X1);+   util_Fclose (f1);+   gen->name = util_Free (gen->name);+   util_Free (gen);+   co1--;+}+++/*-----------------------------------------------------------------------*/++void ufile_InitReadText (void)+{+   int j = 0;+   util_Assert (NULL != f1, "ufile_InitReadText:   unable to read from file");+   if (NText > Dim1) {+      j = fseek (f1, 0L, SEEK_SET);+      util_Assert (0 == j, "ufile_InitReadText:   file rewind failed");+      FillTextArray ();+   }+   NText = n1 = 0;+}+++/*========================================================================*/++static void FillBinArray (void)+/*+ * Read bits, at most Dim2 bytes.+ */+{+   MaxBin = fread (X2, (size_t) 1, (size_t) Dim2, f2);+   n2 = 0;+}++/*-----------------------------------------------------------------------*/++static unsigned long ReadBin_Bits (void *vpar, void *vsta)+/*+ * Return the n-th element of the array. If at end of the array, call+ * FillBinArray to fill the array once again, and then return the first+ * element. Each number uses 32 bits in big-endian form: the first byte+ * makes the most significant bits, and the fourth one makes the least+ * significant.+ */+{+   unsigned long u;++   if (n2 < MaxBin) {+      u  = (unsigned long) X2[n2++] << 24;+      u |= (unsigned long) X2[n2++] << 16;+      u |= (unsigned long) X2[n2++] << 8;+      u |= (unsigned long) X2[n2++];+      NBin += 1.0;+      return u;++   } else if (MaxBin == Dim2) {+      FillBinArray ();+      return ReadBin_Bits (vpar, vsta);++   } else {+      X2 = util_Free (X2);+      util_Fclose (f2);+      f2 = NULL;+      sprintf (S, "%.0f bits have been read.\n", NBin * 32.0);+      strncat (S, "End-of-file detected.\n", (size_t) 25);+      strncat (S, "Not enough bits in file for these test parameters.",+               (size_t) 53);+      util_Error (S);+      return 0;+   }+}++/*-----------------------------------------------------------------------*/++static double ReadBin_U01 (void *vpar, void *vsta)+{+   return ReadBin_Bits (vpar, vsta) * NORM32;+}++/*-----------------------------------------------------------------------*/++static void WrReadBin (void *junk)+{+   printf (" %.0f  bits have been read.\n", NBin * 32.0);+}++/*-----------------------------------------------------------------------*/++unif01_Gen * ufile_CreateReadBin (char *A, long dim) +{+   unif01_Gen *gen;+   size_t leng;+   char name[LEN + 1];++   util_Assert (dim > 0, "ufile_CreateReadBin:   nbuf <= 0.");+   util_Assert (co2 == 0,+      "ufile_CreateReadBin:   only 1 generator at a time can be in use");+   co2++;++   gen = util_Malloc (sizeof (unif01_Gen));++   strncpy (name, "ufile_CreateReadBin:   ", (size_t) LEN);+   strncat (name, A, (size_t) LEN - 30);+   leng = strlen (name);+   gen->name = util_Calloc (leng + 1, sizeof (char));+   strncpy (gen->name, name, leng);++   f2 = util_Fopen (A, "rb");++   /* Each random number will be built of 32 bits = 4 bytes */+   Dim2 = util_Min (ARRAYDIM, 4*dim);+   X2 = util_Calloc ((size_t) Dim2, sizeof (unsigned char));+   FillBinArray ();+   NBin = 0;++   gen->GetBits = &ReadBin_Bits;+   gen->GetU01 = &ReadBin_U01;+   gen->Write = &WrReadBin;+   gen->param = NULL;+   gen->state = NULL;+   return gen;+}++/*-----------------------------------------------------------------------*/++void ufile_DeleteReadBin (unif01_Gen *gen)+{+   X2 = util_Free (X2);+   util_Fclose (f2);+   gen->name = util_Free (gen->name);+   util_Free (gen);+   co2--;+}+++/*-----------------------------------------------------------------------*/++void ufile_InitReadBin (void)+{+   int j = 0;+   util_Assert (NULL != f2, "ufile_InitReadBin:   unable to read from file");+   if (NBin >= Dim2 / 4) {+      j = fseek (f2, 0L, SEEK_SET);+      util_Assert (0 == j, "ufile_InitReadBin:   file rewind failed");+      FillBinArray ();+   }+   NBin = n2 = 0;+}+++/*========================================================================*/++void ufile_Gen2Bin (unif01_Gen *gen, char *fname, double nbits,+   int r, int s)+{+   unsigned long Z;+   unsigned long i, n;+   unsigned char buffer[4];+   FILE *f;+   int k;+   const int KMAX = s / 8;+   int status;++   util_Assert (nbits > 0.0, "ufile_Gen2Bin:   nbits <= 0");+   util_Assert (r >= 0, "ufile_Gen2Bin:   r < 0");+   util_Assert (s % 8 == 0,+                "ufile_Gen2Bin:   s must be in { 8, 16, 24, 32 }");+   util_Assert (nbits / s <= ULONG_MAX,+      "ufile_Gen2Bin:   nbits is too large");+   +   n = 0.5 + nbits / s;+   if (n * (double) s < nbits)+      n++;+   f = util_Fopen (fname, "wb");++   for (i = 0; i < n; i++) {+      Z = unif01_StripB (gen, r, s);+      for (k = KMAX - 1; k >= 0; k--) {+	      buffer[k] = Z & 0xFF;+	      Z >>= 8;+      }+      status = fwrite (buffer, (size_t) 1, (size_t) KMAX, f);+      if (status != KMAX) {+	 perror ("ufile_Gen2Bin:   fwrite");+	 exit (EXIT_FAILURE);+      }+   }++   util_Fclose (f);+}+
+ cbits/testu/src/unif01.c view
@@ -0,0 +1,1472 @@+/*************************************************************************\+ *+ * Package:        TestU01+ * File:           unif01.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "gdef.h"+#include "util.h"+#include "num.h"+#include "chrono.h"+#include "swrite.h"+#include "unif01.h"++#include <math.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+++#define LEN0 500                   /* Length of strings */+#define LEN1 100                   /* Length of strings */++#define MASK32 0xffffffffUL        /* 2^32 - 1 */+++++/*------------------------- extern variables ------------------------------*/++lebool unif01_WrLongStateFlag = FALSE;++++++/* ========================== functions ================================== */++void unif01_WriteNameGen (unif01_Gen *gen)+{+   if (gen->name)+      printf ("%s\n\n", gen->name);+}++void unif01_WriteState (unif01_Gen *gen)+{+   printf ("\nGenerator state:\n");+   gen->Write (gen->state);+   printf ("\n");+}++void unif01_WrLongStateDef (void)+{+   printf ("  Not shown here ... takes too much space\n");+}+++/**************************************************************************/++double unif01_StripD (unif01_Gen *gen, int r)+{+   if (r == 0) {+      return (gen->GetU01) (gen->param, gen->state);+   } else {+      double u = num_TwoExp[r] * (gen->GetU01) (gen->param, gen->state);+      return (u - (long) u);+   }+}++long unif01_StripL (unif01_Gen *gen, int r, long d)+{+   if (r == 0)+      return (long) (d * gen->GetU01 (gen->param, gen->state));+   else {+      double u = num_TwoExp[r] * (gen->GetU01) (gen->param, gen->state);+      return (long) (d * (u - (long) u));+   }  +}++unsigned long unif01_StripB (unif01_Gen *gen, int r, int s)+{+   if (r == 0) {+      return gen->GetBits (gen->param, gen->state) >> (32 - s);+   } else {+      unsigned long u = gen->GetBits (gen->param, gen->state);+      return ((u << r) & MASK32) >> (32 - s);+   }+}+++/*************************************************************************/++/* Dummy generator, always return 0.  */++static double DummyGen_U01 (void *param, void *state)+{+   return 0.0;+}++static unsigned long DummyGen_Bits (void *param, void *state)+{+   return 0;+}++static void WrDummyGen (void *junk)+{+   printf ("   Empty Generator (no state)\n");+}++unif01_Gen * unif01_CreateDummyGen (void)+{+   unif01_Gen *gen;+   size_t len;++   gen = util_Malloc (sizeof (unif01_Gen));+   len = strlen ("Dummy generator that always returns 0");+   gen->name    = util_Calloc (len + 1, sizeof (char));+   strncpy (gen->name, "Dummy generator that always returns 0", len);+   gen->param   = NULL;+   gen->state   = NULL;+   gen->Write   = &WrDummyGen;+   gen->GetBits = &DummyGen_Bits;+   gen->GetU01  = &DummyGen_U01;+   return gen;+}++void unif01_DeleteDummyGen (unif01_Gen *gen)+{+   if (NULL == gen) return;+   gen->name = util_Free (gen->name);+   util_Free (gen);+}++void unif01_DeleteGen (unif01_Gen *gen)+{+   if (NULL == gen) return;+   gen->state = util_Free (gen->state);+   gen->param = util_Free (gen->param);+   gen->name = util_Free (gen->name);+   util_Free (gen);+}+++/**************************************************************************/+/*+ * The original generator is gen0. The position of the bit at which the + * increased precision is applied is s, counting from the most significant + * bit;   v = 1 / 2^s.+ */+typedef struct {+   unif01_Gen *gen0;+   double v;+   int s;+} DoubleGen_param;+++static double DoubleGen_U01 (void *vpar, void *junk)+{+   double U;+   DoubleGen_param *paramD = vpar;+   unif01_Gen *gen = paramD->gen0;++   U = gen->GetU01 (gen->param, gen->state);+   U += paramD->v * gen->GetU01 (gen->param, gen->state);+   if (U < 1.0)+      return U;+   else+      return U - 1.0;+}++static unsigned long DoubleGen_Bits (void *vpar, void *junk)+{+   return (unsigned long) (unif01_NORM32 * DoubleGen_U01 (vpar, junk));+}+++unif01_Gen * unif01_CreateDoubleGen2 (unif01_Gen *gen, double v)+{+   unif01_Gen *genD;+   DoubleGen_param *paramD;+   char *name;+   char str[20];+   size_t len, len2, len3;++   util_Assert (v > 0.0, "unif01_CreateDoubleGen2:   h <= 0");+   util_Assert (v < 1.0, "unif01_CreateDoubleGen2:   h >= 1");+   genD = util_Malloc (sizeof (unif01_Gen));+   paramD = util_Malloc (sizeof (DoubleGen_param));+   paramD->s = -num_Log2(v);+   paramD->v = v;+   paramD->gen0 = gen;++   len = strlen (gen->name);+   len2 = strlen ("\nunif01_CreateDoubleGen2 with h = ");+   len += len2;+   sprintf (str, "%-g", v);+   len3 = strlen (str);+   len += len3;+   name = util_Calloc (len + 1, sizeof (char));+   strncpy (name, gen->name, len);+   strncat (name, "\nunif01_CreateDoubleGen2 with h = ", len2);+   strncat (name, str, len3);++   /* The state of the double generator is simply the state of the original+      generator */+   genD->name    = name;+   genD->param   = paramD;+   genD->state   = gen->state;+   genD->Write   = gen->Write;+   genD->GetBits = &DoubleGen_Bits;+   genD->GetU01  = &DoubleGen_U01;+   return genD;+}++unif01_Gen * unif01_CreateDoubleGen (unif01_Gen *gen, int s)+{+   unif01_Gen *genD;+   DoubleGen_param *paramD;+   char *name;+   char str[8];+   size_t len, len2, len3;++   util_Assert (s > 0, "unif01_CreateDoubleGen:   s <= 0");+   genD = unif01_CreateDoubleGen2 (gen, 1.0 / num_TwoExp[s]);+   paramD = genD->param;+   paramD->s = s;++   len = strlen (gen->name);+   len2 = strlen ("\nunif01_CreateDoubleGen with s = ");+   len += len2;+   sprintf (str, "%-d", paramD->s);+   len3 = strlen (str);+   len += len3;+   name = util_Calloc (len + 1, sizeof (char));+   strncpy (name, gen->name, len);+   strncat (name, "\nunif01_CreateDoubleGen with s = ", len2);+   strncat (name, str, len3);+   genD->name    = name;+   return genD;+}++void unif01_DeleteDoubleGen (unif01_Gen *gen)+{+   if (NULL == gen) return;+   gen->param = util_Free (gen->param);+   gen->name = util_Free (gen->name);+   util_Free (gen);+}+++/**************************************************************************/++typedef struct {+   unif01_Gen *gen0;                /* Original generator */+   long *ILac;                      /* Table of lacunary indices */+   int k;                           /* Size of ILac */+   int cur;                         /* Current index in the table */+   long n;+} LacGen_param;++static double LacGen_U01 (void *vpar, void *junk)+{+   LacGen_param *paramL = vpar;+   unif01_Gen *gen = paramL->gen0;+   int cur = paramL->cur;+   long *ILac = paramL->ILac;+   long j;+#if 1+   if (cur > 0) {+     for (j = 2; j <= ILac[cur] - ILac[cur - 1]; j++)+        gen->GetU01 (gen->param, gen->state);+   } else {+     for (j = 0; j < ILac[0]; j++)+        gen->GetU01 (gen->param, gen->state);+   }+   cur++;+   if (cur >= paramL->k)+      cur = 0;+   paramL->cur = cur;++#else+   /* For debugging: write the lacunary indices of the random numbers outputted */+   if (cur > 0) {+      for (j = 2; j <= ILac[cur] - ILac[cur - 1]; j++) {+         gen->GetU01 (gen->param, gen->state);+         paramL->n++;+      }+   } else {+      for (j = 0; j < ILac[0]; j++) {+         gen->GetU01 (gen->param, gen->state);+         paramL->n++;+      }+   }+   cur++;+   if (cur >= paramL->k)+      cur = 0;+   paramL->cur = cur;+   printf ("Lac = %ld\n", paramL->n);+   paramL->n++;+#endif++   return gen->GetU01 (gen->param, gen->state);+}++static unsigned long LacGen_Bits (void *vpar, void *junk)+{+   LacGen_param *paramL = vpar;+   unif01_Gen *gen = paramL->gen0;+   int cur = paramL->cur;+   long *ILac = paramL->ILac;+   long j;++   if (cur > 0) {+     for (j = 2; j <= ILac[cur] - ILac[cur - 1]; j++)+        gen->GetBits (gen->param, gen->state);+   } else {+     for (j = 0; j < ILac[0]; j++)+        gen->GetBits (gen->param, gen->state);+   }+   cur++;+   if (cur >= paramL->k)+      cur = 0;+   paramL->cur = cur;+   return gen->GetBits (gen->param, gen->state);+}++unif01_Gen * unif01_CreateLacGen (unif01_Gen *gen, int k, long I[])+{+   unif01_Gen *genL;+   LacGen_param *paramL;+   char name[LEN0 + 1] = "";+   char str[16];+   size_t len, len2;+   int j;++   genL = util_Malloc (sizeof (unif01_Gen));+   paramL = util_Malloc (sizeof (LacGen_param));+   paramL->gen0 = gen;+   paramL->k = k;+   paramL->cur = 0;+   paramL->n = 0;+   paramL->ILac = util_Calloc ((size_t) k, sizeof (long));+   for (j = 0; j < k; j++)+      paramL->ILac[j] = I[j];++   len = strlen (gen->name);+   strncpy (name, gen->name, len);+   len2 = strlen ("\nunif01_CreateLacGen with k = ");+   len += len2;+   strncat (name, "\nunif01_CreateLacGen with k = ", len2);+   sprintf (str, "%-d", k);+   strncat (name, str, 16);+   strncat (name, ", I = (", 8);++   for (j = 0; j < k; j++) {+      sprintf (str, "%-ld", I[j]);+      strncat (name, str, 16);+      if (j < k - 1)+         strncat (name, ", ", 2);+      else+         strncat (name, ")", 1);+   }++   len = strlen (name);+   genL->name = util_Calloc (1 + len, sizeof (char));+   strncpy (genL->name, name, len);++   /* The state of the lacunary generator is simply the state of the original+      generator */+   genL->param   = paramL;+   genL->state   = gen->state;+   genL->Write   = gen->Write;+   genL->GetBits = &LacGen_Bits;+   genL->GetU01  = &LacGen_U01;+   return genL;+}++void unif01_DeleteLacGen (unif01_Gen *gen)+{+   LacGen_param *param;+   if (NULL == gen) return;+   param = gen->param;+   param->ILac = util_Free (param->ILac);+   gen->param = util_Free (gen->param);+   gen->name = util_Free (gen->name);+   util_Free (gen);+}+++/**************************************************************************/++typedef struct {+   unif01_Gen *gen0;       /* The original generator */+   double R;               /* Total probability over [0, a) */+   double S;               /* (R - a) / (1 - a) */+   double invp;            /* Inverse of probability density over [0, a) */+   double invq;            /* Inverse of probability density over [a, 1) */+} BiasGen_param;+++static double BiasGen_U01 (void *vpar, void *junk)+{+   double U;+   BiasGen_param *paramB = vpar;+   unif01_Gen *gen = paramB->gen0;++   U = gen->GetU01 (gen->param, gen->state);+   if (U < paramB->R)+      return (U * paramB->invp);+   else+      return (U - paramB->S) * paramB->invq;+}+++static unsigned long BiasGen_Bits (void *vpar, void *junk)+{+   return (unsigned long) (unif01_NORM32 * BiasGen_U01 (vpar, junk));+}+++unif01_Gen * unif01_CreateBiasGen (unif01_Gen *gen, double a, double R)+{+   const double Epsilon = 2.0E-16;+   unif01_Gen *genB;+   BiasGen_param *paramB;+   double p;                 /* probability density over [0, a) */+   double q;                 /* probability density over [a, 1) */+   char name[LEN0 + 1] = "";+   char str[16];+   size_t len;++   util_Assert (R >= 0.0 && R <= 1.0,+                "unif01_CreateBiasGen:   P must be in [0, 1]");+   util_Assert (a > 0.0 && a < 1.0,+                "unif01_CreateBiasGen:   a must be in (0, 1)");++   genB = util_Malloc (sizeof (unif01_Gen));+   paramB = util_Malloc (sizeof (BiasGen_param));+   paramB->gen0 = gen;++   p = R / a;+   q = (1.0 - R) / (1.0 - a);+   if (p < Epsilon)+      paramB->invp = 0.0;+   else+      paramB->invp = 1.0 / p;+   if (q < Epsilon)+      paramB->invq = 0.0;+   else+      paramB->invq = 1.0 / q;+   paramB->R = R;+   paramB->S = (p - q) * a;++   strncpy (name, gen->name, LEN0);+   len = strlen ("\nunif01_CreateBiasGen with  P = ");+   strncat (name, "\nunif01_CreateBiasGen with  P = ", len);+   sprintf (str, "%.4f", R);+   len = strlen (str);+   strncat (name, str, len);+   strncat (name, ",  a = ", 8);+   sprintf (str, "%.4f", a);+   len = strlen (str);+   strncat (name, str, len);++   len = strlen (name);+   genB->name = util_Calloc (1 + len, sizeof (char));+   strncpy (genB->name, name, len);++   /* The state of the bias generator is simply the state of the original+      generator */+   genB->param   = paramB;+   genB->state   = gen->state;+   genB->Write   = gen->Write;+   genB->GetBits = &BiasGen_Bits;+   genB->GetU01  = &BiasGen_U01;+   return genB;+}++void unif01_DeleteBiasGen (unif01_Gen *gen)+{+   if (NULL == gen) return;+   gen->param = util_Free (gen->param);+   gen->name = util_Free (gen->name);+   util_Free (gen);+}+++/*************************************************************************/+typedef struct {+   unif01_Gen *gen0;               /* The original generator */+   int k;                          /* keep k numbers */+   int s;                          /* skip s numbers */+   int n;                          /* state */+} LuxGen_param;+++static unsigned long LuxGen_Bits (void *vpar, void *junk)+{+   LuxGen_param *paramL = vpar;+   unif01_Gen *gen = paramL->gen0;+   if (0 == paramL->n) {+      int i;+      for (i = paramL->s; i > 0; --i)+         gen->GetBits (gen->param, gen->state);+      paramL->n = paramL->k;+   }+   --paramL->n;+   return gen->GetBits (gen->param, gen->state);+}+++static double LuxGen_U01 (void *vpar, void *junk)+{+   LuxGen_param *paramL = vpar;+   unif01_Gen *gen = paramL->gen0;+   if (0 == paramL->n) {+      int i;+      for (i = paramL->s; i > 0; --i)+         gen->GetU01 (gen->param, gen->state);+      paramL->n = paramL->k;+   }+   --paramL->n;+   return gen->GetU01 (gen->param, gen->state);+}+++unif01_Gen * unif01_CreateLuxGen (unif01_Gen *gen, int k, int L)+{+   unif01_Gen *genL;+   LuxGen_param *paramL;+   char name[LEN0 + 1] = "";+   char str[26];+   size_t len;+   const int s = L - k;++   util_Assert (k > 0, "unif01_CreateLuxGen:   k <= 0");+   util_Assert (k <= L, "unif01_CreateLuxGen:   L < k");++   genL = util_Malloc (sizeof (unif01_Gen));+   paramL = util_Malloc (sizeof (LuxGen_param));+   paramL->gen0 = gen;+   paramL->s = s;+   paramL->k = k;+   paramL->n = k;++   strncpy (name, gen->name, LEN0);+   len = strlen ("\nunif01_CreateLuxGen:   k = ");+   strncat (name, "\nunif01_CreateLuxGen:   k = ", len);+   sprintf (str, "%-d,   L = %-d", k, L);+   len = strlen (str);+   strncat (name, str, len);+   len = strlen (name);+   genL->name = util_Calloc (1 + len, sizeof (char));+   strncpy (genL->name, name, len);++   genL->param   = paramL;+   genL->state   = gen->state;+   genL->Write   = gen->Write;+   genL->GetBits = &LuxGen_Bits;+   genL->GetU01  = &LuxGen_U01;+   return genL;+}+++void unif01_DeleteLuxGen (unif01_Gen *gen)+{+   if (NULL == gen) return;+   gen->param = util_Free (gen->param);+   gen->name = util_Free (gen->name);+   util_Free (gen);+}+++/*************************************************************************/+typedef struct {+   unif01_Gen *gen0;               /* The original generator */+   unsigned long mask;             /* s most significant bits */+} TruncGen_param;+++static unsigned long TruncGen_Bits (void *vpar, void *junk)+{+   TruncGen_param *paramT = vpar;+   unif01_Gen *gen = paramT->gen0;++   return paramT->mask & gen->GetBits (gen->param, gen->state);+}++static double TruncGen_U01 (void *vpar, void *vsta)+{+   return TruncGen_Bits (vpar, vsta) * unif01_INV32;+}++unif01_Gen * unif01_CreateTruncGen (unif01_Gen *gen, int b)+{+   unif01_Gen *genT;+   TruncGen_param *paramT;+   char name[LEN0 + 1] = "";+   char str[16];+   size_t len;++   if (b < 0)+      util_Error ("unif01_CreateTruncGen:   s < 0");+   if (b > 32)+      util_Error ("unif01_CreateTruncGen:   s > 32");++   genT = util_Malloc (sizeof (unif01_Gen));+   paramT = util_Malloc (sizeof (TruncGen_param));+   paramT->gen0 = gen;+   if (b >= 32)+      paramT->mask = 0xffffffffU;+   else+      paramT->mask = (0xffffffffU >> (32 - b)) << (32 - b);++   strncpy (name, gen->name, LEN0);+   len = strlen ("\nunif01_CreateTruncGen with b = ");+   strncat (name, "\nunif01_CreateTruncGen with b = ", len);+   sprintf (str, "%-d", b);+   len = strlen (str);+   strncat (name, str, len);+   strncat (name, "  bits:", 8);++   len = strlen (name);+   genT->name = util_Calloc (1 + len, sizeof (char));+   strncpy (genT->name, name, len);++   /* The state of the trunc generator is simply the state of the original+      generator */+   genT->param   = paramT;+   genT->state   = gen->state;+   genT->Write   = gen->Write;+   genT->GetBits = &TruncGen_Bits;+   genT->GetU01  = &TruncGen_U01;+   return genT;+}++void unif01_DeleteTruncGen (unif01_Gen *gen)+{+   if (NULL == gen) return;+   gen->param = util_Free (gen->param);+   gen->name = util_Free (gen->name);+   util_Free (gen);+}+++/************************************************************************/+/*+ * The original generator is gen0. The r most significant bits of each random+ * number are dropped, and the s following bits are kept. + */+typedef struct {+   unif01_Gen *gen0;+   int nrows;   /* Number of integers used in making a new random number */+   int B;       /* Number of blocks in 1 s-bits group */+   int w;       /* Number of bits in a block */+   unsigned long maskw;   /* Mask of w bits = 2^w - 1 */+   int r;+   int s;+} BitBlock_param;+++typedef struct {+   unsigned long *Z;+   int n;        /* Build n random numbers at a time, n <= 32 */+   BitBlock_param *param;+} BitBlock_state;+++static unsigned long BitBlock_Bits (void *vpar, void *vsta)+{+   BitBlock_state *state = vsta;++   if (state->n <= 0) {+      BitBlock_param *param = vpar;+      unsigned long X;+      int i, j;++      /* Generate B random integers Z from the bits of nrows random integers+         X from the original gen0 */+      for (j = 0; j < param->B; j++) +	 state->Z[j] = 0;+      for (i = 0; i < param->nrows; i++) {+ 	 /* Get a random integer X of s bits */+ 	 X = unif01_StripB (param->gen0, param->r, param->s);+         /* Take w of the s bits of X to make bits of Z[j] */+         for (j = 0; j < param->B; j++) {+	    state->Z[j] <<= param->w;+	    state->Z[j] |= X & param->maskw;+	    X >>= param->w;+	 }+      }+      state->n = param->B;+   }+   return state->Z[--state->n];+}+++static double BitBlock_U01 (void *vpar, void *vsta)+{+   return BitBlock_Bits (vpar, vsta) * unif01_INV32;+}+++static void WrBitBlock (void *vsta)+{+   BitBlock_state *state = vsta;+   state->param->gen0->Write (state->param->gen0->state);+}+++unif01_Gen * unif01_CreateBitBlockGen (unif01_Gen *gen, int r, int s, int w)+{+   unif01_Gen *genV;+   BitBlock_param *paramV;+   BitBlock_state *stateV;+   char *name;+   char str[64];+   size_t len, len2, len3;+ +   util_Assert (s > 0, "unif01_CreateBitBlockGen:   s <= 0");+   util_Assert (r >= 0, "unif01_CreateBitBlockGen:   r < 0");+   util_Assert (r + s <= 32, "unif01_CreateBitBlockGen:   r + s > 32");+   util_Assert (w > 0, "unif01_CreateBitBlockGen:   w < 1");+   util_Assert (32 % w == 0, "unif01_CreateBitBlockGen:   w must divide 32");++   genV = util_Malloc (sizeof (unif01_Gen));+   paramV = util_Malloc (sizeof (BitBlock_param));+   stateV = util_Malloc (sizeof (BitBlock_state));+   paramV->gen0 = gen;+   paramV->s = s;+   paramV->r = r;+   paramV->w = w;+   paramV->B = s / w;+   paramV->maskw = num_TwoExp[paramV->w] - 1.0;+   paramV->nrows = 32 / w;+   stateV->param = paramV;+   stateV->n = 0;+   stateV->Z = util_Calloc ((size_t) paramV->B, sizeof (unsigned long));++   len = strlen (gen->name);+   len2 = strlen ("\nunif01_CreateBitBlockGen:   ");+   len += len2;+   sprintf (str, "r = %1d,   s = %1d,   w = %1d", r, s, w);+   len3 = strlen (str);+   len += len3;+   name = util_Calloc (len + 1, sizeof (char));+   strncpy (name, gen->name, len);+   strncat (name, "\nunif01_CreateBitBlockGen:   ", len2);+   strncat (name, str, len3);+   genV->name    = name;+   genV->param   = paramV;+   genV->state   = stateV;+   genV->Write   = &WrBitBlock;+   genV->GetBits = &BitBlock_Bits;+   genV->GetU01  = &BitBlock_U01;+   return genV;+}+++void unif01_DeleteBitBlockGen (unif01_Gen *gen)+{+   BitBlock_state *state;+   if (NULL == gen) return;+   state = gen->state;+   state->Z = util_Free (state->Z);+   gen->param = util_Free (gen->param);+   gen->state = util_Free (gen->state);+   gen->name = util_Free (gen->name);+   util_Free (gen);+}+++/************************************************************************/++static double CombGen2_U01_Add (void *vpar, void *junk)+{+   unif01_Comb2_Param *g = vpar;+   unif01_Gen *gen1 = g->gen1;+   unif01_Gen *gen2 = g->gen2;+   double U;++   U = gen1->GetU01 (gen1->param, gen1->state) ++       gen2->GetU01 (gen2->param, gen2->state);+   if (U >= 1.0)+      return (U - 1.0);+   else+      return U;+}+++static unsigned long CombGen2_Bits_Add (void *vpar, void *junk)+{+   return (unsigned long) (unif01_NORM32 * CombGen2_U01_Add (vpar, junk));+}+++static unsigned long CombGen2_Bits_Xor (void *vpar, void *junk)+{+   unif01_Comb2_Param *g = vpar;+   unif01_Gen *gen1 = g->gen1;+   unif01_Gen *gen2 = g->gen2;++   return gen1->GetBits (gen1->param, gen1->state) ^+          gen2->GetBits (gen2->param, gen2->state);+}+++static double CombGen2_U01_Xor (void *vpar, void *junk)+{+   return CombGen2_Bits_Xor (vpar, junk) * unif01_INV32;+}+++static void WrCombGen2 (void *vsta)+{+   unif01_Comb2_Param *g = vsta;+   printf ("2 Combined Generators:\n");+   g->gen1->Write (g->gen1->state);+   g->gen2->Write (g->gen2->state);+}+++static unif01_Gen * CreateCombGen2 (unif01_Gen *g1, unif01_Gen *g2, +   char *mess, char *name)+{+   unif01_Gen *gen;+   unif01_Comb2_Param *paramC;+   size_t len, L;++   gen = util_Malloc (sizeof (unif01_Gen));+   paramC = util_Malloc (sizeof (unif01_Comb2_Param));+   paramC->gen1 = g1;+   paramC->gen2 = g2;++   len = strlen (g1->name) + strlen (g2->name) + strlen (name) + strlen (mess);+   len += 5;+   gen->name = util_Calloc (len + 1, sizeof (char));+   L = strlen (mess);+   if (L > 0) {+      strncpy (gen->name, mess, len);+      if (mess[L - 1] != ':')+         strncat (gen->name, ":", 3);+      strncat (gen->name, "\n", 3);+   }+   strncat (gen->name, g1->name, len);+   strncat (gen->name, "\n", 3);+   strncat (gen->name, g2->name, len);+   strncat (gen->name, name, len);++   gen->param  = paramC;+   gen->state  = paramC;+   gen->Write  = &WrCombGen2;+   return gen;+}+++unif01_Gen * unif01_CreateCombAdd2 (unif01_Gen *g1, unif01_Gen *g2, char *Mess)+{+   unif01_Gen *gen;+   gen = CreateCombGen2 (g1, g2, Mess, "\nunif01_CreateCombAdd2");+   gen->GetU01 = &CombGen2_U01_Add;+   gen->GetBits = &CombGen2_Bits_Add;+   return gen;+}+++unif01_Gen * unif01_CreateCombXor2 (unif01_Gen *g1, unif01_Gen *g2,+   char *Mess)+{+   unif01_Gen *gen;+   gen = CreateCombGen2 (g1, g2, Mess, "\nunif01_CreateCombXor2");+   gen->GetU01 = &CombGen2_U01_Xor;+   gen->GetBits = &CombGen2_Bits_Xor;+   return gen;+}++void unif01_DeleteCombGen (unif01_Gen *gen)+{+   if (NULL == gen) return;+   gen->param = util_Free (gen->param);+   gen->name = util_Free (gen->name);+   util_Free (gen);+}+++/************************************************************************/++typedef struct {+  unif01_Gen *gen1;+  unif01_Gen *gen2;+  unif01_Gen *gen3;+} Comb3_Param;+++static double CombGen3_U01_Add (void *vpar, void *junk)+{+   Comb3_Param *g = vpar;+   unif01_Gen *gen1 = g->gen1;+   unif01_Gen *gen2 = g->gen2;+   unif01_Gen *gen3 = g->gen3;+   double U;++   /*+   When the combined generator is used to generate random integers, in rare+   cases, an integer may differ by 1 unit depending on the order of+   addition of the 3 terms (one from each component). This is due+   to the last bit (bit 53) of the value returned which may be affected by+   floating-point numerical errors. Furthermore, the result+   may be different if the addition is done without function calls+   (as in the pre-programmed version of Wichmann-Hill for example in+   {\tt ulcg\_CreateCombWH3}), in which case, the 2 extra guard bits+   required by the IEEE-754 standard in floating-point arithmetic+   operations may give a more precise result.+   */+   U = gen1->GetU01 (gen1->param, gen1->state) ++       gen2->GetU01 (gen2->param, gen2->state) ++       gen3->GetU01 (gen3->param, gen3->state);++   if (U < 1.0)+      return U;+   if (U < 2.0)+      return (U - 1.0);+   return U - 2.0;+}+++static unsigned long CombGen3_Bits_Add (void *vpar, void *junk)+{+   return (unsigned long) (CombGen3_U01_Add (vpar, junk) * unif01_NORM32);+}+++static unsigned long CombGen3_Bits_Xor (void *vpar, void *junk)+{+   Comb3_Param *g = vpar;+   unif01_Gen *gen1 = g->gen1;+   unif01_Gen *gen2 = g->gen2;+   unif01_Gen *gen3 = g->gen3;++   return  gen1->GetBits (gen1->param, gen1->state) ^ +           gen2->GetBits (gen2->param, gen2->state) ^+           gen3->GetBits (gen3->param, gen3->state);+}+++static double CombGen3_U01_Xor (void *vpar, void *junk)+{+   return CombGen3_Bits_Xor (vpar, junk) * unif01_INV32;+}+++static void WrCombGen3 (void *vsta )+{+   Comb3_Param *g = vsta;+   printf ("3 Combined Generators:\n");+   g->gen1->Write (g->gen1->state);+   g->gen2->Write (g->gen2->state);+   g->gen3->Write (g->gen3->state);+}+++static unif01_Gen * CreateCombGen3 (unif01_Gen *g1, unif01_Gen *g2,+   unif01_Gen *g3, const char *mess, const char *name)+{+   unif01_Gen *gen;+   Comb3_Param *paramC;+   size_t len, L;++   gen = util_Malloc (sizeof (unif01_Gen));+   paramC = util_Malloc (sizeof (Comb3_Param));+   paramC->gen1 = g1;+   paramC->gen2 = g2;+   paramC->gen3 = g3;++   len = strlen (g1->name) + strlen (g2->name) + strlen (g3->name) ++         strlen (name) + strlen (mess);+   len += 5;+   gen->name = util_Calloc (len + 1, sizeof (char));+   L = strlen (mess);+   if (L > 0) {+      strncpy (gen->name, mess, len);+      if (mess[L - 1] != ':')+         strncat (gen->name, ":", 3);+      strncat (gen->name, "\n", 3);+   }+   strncat (gen->name, g1->name, len);+   strncat (gen->name, "\n", 3);+   strncat (gen->name, g2->name, len);+   strncat (gen->name, "\n", 3);+   strncat (gen->name, g3->name, len);+   strncat (gen->name, name, len);++   gen->param  = paramC;+   gen->state  = paramC;+   gen->Write  = &WrCombGen3;+   return gen;+}+++unif01_Gen * unif01_CreateCombAdd3 (unif01_Gen *g1, unif01_Gen *g2,+   unif01_Gen *g3, char *mess)+{+   unif01_Gen *gen;+   gen = CreateCombGen3 (g1, g2, g3, mess, "\nunif01_CreateCombAdd3");+   gen->GetU01 = &CombGen3_U01_Add;+   gen->GetBits = &CombGen3_Bits_Add;+   return gen;+}+++unif01_Gen * unif01_CreateCombXor3 (unif01_Gen *g1, unif01_Gen *g2,+   unif01_Gen *g3, char *mess)+{+   unif01_Gen *gen;+   gen = CreateCombGen3 (g1, g2, g3, mess, "\nunif01_CreateCombXor3");+   gen->GetU01 = &CombGen3_U01_Xor;+   gen->GetBits = &CombGen3_Bits_Xor;+   return gen;+}+++/*=========================================================================*/++typedef struct {+   int j;                           /* Which random number */+   int i;                           /* Which generator */+   int L;+   int k;                           /* Number of parallel generators */+   unif01_Gen **agen;               /* Parallel generators */+} ParallelGen_state;+++static double ParallelGen_U01 (void *junk, void *vsta)+{+   ParallelGen_state *stateP = vsta;+   unif01_Gen *g;++   if (++stateP->j >= stateP->L) {+      stateP->j = 0;+      if (++stateP->i >= stateP->k)+         stateP->i = 0;+   }+   g = stateP->agen[stateP->i];+   return g->GetU01 (g->param, g->state);+}+++static unsigned long ParallelGen_Bits (void *junk, void *vsta)+{+   ParallelGen_state *stateP = vsta;+   unif01_Gen *g;++   if (++stateP->j >= stateP->L) {+      stateP->j = 0;+      if (++stateP->i >= stateP->k)+         stateP->i = 0;+   }+   g = stateP->agen[stateP->i];+   return g->GetBits (g->param, g->state);+}+++static void WrParallelGen (void *vsta)+{+   int i;+   ParallelGen_state *state = vsta;+   printf ("   i = %d,    j = %d\n\nParallel Generators:\n", state->i, state->j);+   for (i = 0; i < state->k; ++i)+      unif01_WriteNameGen(state->agen[i]);+}+++unif01_Gen * unif01_CreateParallelGen (int k, unif01_Gen *gen[], int L)+{+#define NCAT 16+   unif01_Gen *genP;+   ParallelGen_state *stateP;+   char name[LEN0 + 1] = {0};+   char str[NCAT + 1];+   size_t len;+   int j;++   genP = util_Malloc (sizeof (unif01_Gen));+   stateP = util_Malloc (sizeof (ParallelGen_state));+   stateP->k = k;+   stateP->L = L;+   stateP->i = k;+   stateP->j = L;+   stateP->agen = util_Calloc ((size_t) k, sizeof (unif01_Gen *));+   for (j = 0; j < k; j++)+      stateP->agen[j] = gen[j];++   len = strlen ("unif01_CreateParallelGen:   k = ");+   strncpy (name, "unif01_CreateParallelGen:   k = ", len);+   sprintf (str, "%-d", k);+   strncat (name, str, NCAT);+   strncat (name, ",   L = ", NCAT);+   sprintf (str, "%-d", L);+   strncat (name, str, NCAT);+   len = strlen (name);+   genP->name = util_Calloc (1 + len, sizeof (char));+   strncpy (genP->name, name, len);++   genP->state   = stateP;+   genP->Write   = &WrParallelGen;+   genP->GetBits = &ParallelGen_Bits;+   genP->GetU01  = &ParallelGen_U01;+   return genP;+#undef NCAT +}+++void unif01_DeleteParallelGen (unif01_Gen *gen)+{+   ParallelGen_state *state;+   if (NULL == gen) return;+   state = gen->state;+   state->agen = util_Free (state->agen);+   gen->state = util_Free (gen->state);+   gen->name = util_Free (gen->name);+   util_Free (gen);+}+++/*=========================================================================*/++static double (*externGen_U01)(void);  /* The external generator U01 */+static int coGU = 0;                       /* Counter for GU_U01 */+++static double GU_U01 (void *param, void *state)+{+   return externGen_U01 ();+}+++static unsigned long GU_Bits (void *param, void *state)+{+   return (unsigned long) (externGen_U01 () * unif01_NORM32);+}+++static void WrExternGen (void *state)+{+}+++unif01_Gen *unif01_CreateExternGen01 (char *name, double (*f_U01)(void))+{+   unif01_Gen *gen;+   size_t leng;++   util_Assert (coGU == 0,+      "unif01_CreateExternGen01:   only 1 such generator can be in use");+   coGU++;+   gen = util_Malloc (sizeof (unif01_Gen));+   gen->state = NULL;+   gen->param = NULL;+   gen->Write = WrExternGen;+   externGen_U01 = f_U01;+   gen->GetU01 = GU_U01;+   gen->GetBits = GU_Bits;++   if (name) {+      leng = strlen (name);+      gen->name = util_Calloc (leng + 2, sizeof (char));+      strncpy (gen->name, name, leng);+   } else {+      gen->name = util_Calloc (1, sizeof (char));+      gen->name[0] = '\0';+   }+   return gen;+}+++void unif01_DeleteExternGen01 (unif01_Gen * gen)+{+   if (NULL == gen)+      return;+   gen->name = util_Free (gen->name);+   util_Free (gen);+   coGU--;+}+++/*=========================================================================*/++static void (*externGen_Bits)(const unsigned int, unsigned int*);+static int coGB = 0;                        /* Counter for GB_U01 */++static const int RANDOM_BATCH_SIZE = 1000;++static void set_param (void* param, unsigned int value) {+  *((unsigned int*) param) = value;+}++static unsigned int get_param(void* param) {+  return *((unsigned int*) param);+}++static void reset_param (void* param) {+  set_param(param, 0);+}++static void increment_param (void* param) {+  set_param(param, get_param(param) + 1);+}++static int has_run_out_of_randoms (void* param) {+  return get_param(param) == RANDOM_BATCH_SIZE;+}++static unsigned int next_param_increment (void* param) {+  unsigned int result = get_param(param);+  increment_param(param);+  return result;+}++static unsigned int get_next_value (void* param, void* state) {+  unsigned int index = next_param_increment(param);+  return ((unsigned int*) state)[index];+}++static void produce_new_batch(void* state) {+    externGen_Bits (RANDOM_BATCH_SIZE, state);+}++static unsigned int generate_next_bits (void* param, void* state) {+  if (has_run_out_of_randoms(param)) {+    produce_new_batch(state);+    reset_param(param);+  }+  return get_next_value(param, state);+}+++static double GB_U01 (void *param, void *state)+{+  return generate_next_bits(param, state) / unif01_NORM32;+}+++static unsigned long GB_Bits (void *param, void *state)+{+  return generate_next_bits(param, state);+}+++unif01_Gen* unif01_CreateExternGenBits (void (*f_Bits)(const unsigned int,+                                                       unsigned int*))+{+   unif01_Gen *gen;+   size_t leng;++   util_Assert (coGB == 0,+      "unif01_CreateExternGenBits:   only 1 such generator can be in use");+   coGB++;+   gen = util_Malloc (sizeof (unif01_Gen));+   gen->state = util_Malloc (sizeof (unsigned int) * RANDOM_BATCH_SIZE);+   gen->param = util_Malloc (sizeof (unsigned int));+   gen->Write = WrExternGen;+   externGen_Bits = f_Bits;+   gen->GetU01 = GB_U01;+   gen->GetBits = GB_Bits;+   produce_new_batch(gen->state);+   reset_param(gen->param);++   gen->name = util_Calloc (1, sizeof (char));+   gen->name[0] = '\0';+   return gen;+}+++void unif01_DeleteExternGenBits (unif01_Gen * gen)+{+   if (NULL == gen)+      return;+   gen->name = util_Free (gen->name);+   util_Free (gen->state);+   util_Free (gen->param);+   util_Free (gen);+   coGB--;+}+++/*=========================================================================*/++static unsigned long (*externGenLong_Bits)(void);+static int coGBL = 0;                        /* Counter for GBLong_U01 */++static double GBLong_U01 (void *param, void *state)+{+   return externGenLong_Bits () / unif01_NORM32;+}++static unsigned long GBLong_Bits (void *param, void *state)+{+   return externGenLong_Bits ();+}+++unif01_Gen *unif01_CreateExternGenBitsL (char *name,+    unsigned long (*f_Bits)(void))+{+   unif01_Gen *gen;+   size_t leng;++   util_Assert (coGBL == 0,+      "unif01_CreateExternGenBitsL:   only 1 such generator can be in use");+   coGBL++;+   gen = util_Malloc (sizeof (unif01_Gen));+   gen->state = NULL;+   gen->param = NULL;+   gen->Write = WrExternGen;+   externGenLong_Bits = f_Bits;+   gen->GetU01 = GBLong_U01;+   gen->GetBits = GBLong_Bits;++   if (name) {+      leng = strlen (name);+      gen->name = util_Calloc (leng + 2, sizeof (char));+      strncpy (gen->name, name, leng);+   } else {+      gen->name = util_Calloc (1, sizeof (char));+      gen->name[0] = '\0';+   }+   return gen;+}+++void unif01_DeleteExternGenBitsL (unif01_Gen * gen)+{+   if (NULL == gen)+      return;+   gen->name = util_Free (gen->name);+   util_Free (gen);+   coGBL--;+}+++/**************************************************************************/++void unif01_TimerGen (unif01_Gen *gen, unif01_TimerRec * pt, long n,+    lebool fU01)+{+   chrono_Chrono *C1;+   double U;+   unsigned long V;+   long i;++   C1 = chrono_Create ();+   if (fU01)+      for (i = 0; i < n; i++)+         U = gen->GetU01 (gen->param, gen->state);+   else+      for (i = 0; i < n; i++)+         V = gen->GetBits (gen->param, gen->state);+   pt->time = chrono_Val (C1, chrono_sec);+   pt->mean = 0.0;+   pt->n = n;+   pt->fU01 = fU01;+   pt->gen = gen;+   chrono_Delete (C1);+}++void unif01_TimerSumGen (unif01_Gen *gen, unif01_TimerRec * pt, long n,+    lebool fU01)+{+   chrono_Chrono *C1;+   double Sum = 0.0;+   unsigned long Y = 0;+   long i;++   C1 = chrono_Create ();+   if (fU01)+      for (i = 0; i < n; i++)+         Sum += gen->GetU01 (gen->param, gen->state);+   else+      for (i = 0; i < n; i++)+         Y += gen->GetBits (gen->param, gen->state);+   pt->time = chrono_Val (C1, chrono_sec);+   if (fU01)+      pt->mean = Sum / n;+   else+      pt->mean = (double) Y / n;  +   pt->n = n;+   pt->gen = gen;+   pt->fU01 = fU01;+   chrono_Delete (C1);+}++void unif01_WriteTimerRec (unif01_TimerRec *R)+{+   unif01_Gen *gen = R->gen;+   char stri [LEN1 + 1] = "";+   char *p;+   size_t len;++   printf ("\n-------------  Results of speed test  ---------------");+   printf ("\n\n Host:        ");+   if (swrite_Host)+      gdef_WriteHostName ();+   else+      printf ("\n");++   /* Print only the generator name, without the parameters or seeds. */+   /* The parameters start after the first blank; name ends with ':' */+   printf (" Generator:   ");+   len = strcspn (gen->name, ":");+   strncpy (stri, gen->name, len);+   stri [len] = '\0';+   printf ("%s", stri);+   p = strstr (gen->name, "unif01");+   while (p != NULL) {+      /* For Filters or Combined generators */+      len = strcspn (p, " \0");+      strncpy (stri, p, len);+      stri [len] = '\0';+      printf (",   %s", stri);+      p += len;+      p = strstr (p, "unif01");+   }+   if (R->fU01) {+      printf ("\n Method:      GetU01");+      if (R->mean > 0.0)+         printf ("\n Mean =       %.15f", R->mean);+   } else {+      printf ("\n Method:      GetBits");+      if (R->mean > 0.0)+         printf ("\n Mean =       %.16g", R->mean);+   }+   printf ("\n Number of calls:  %ld", R->n);+   printf ("\n Total CPU time: ");+   printf ("%6.2f sec\n\n", R->time);+}++void unif01_TimerGenWr (unif01_Gen *gen, long n, lebool fU01)+{+   unif01_TimerRec timer;+   unif01_TimerGen (gen, &timer, n, fU01);+   unif01_WriteTimerRec (&timer);+}++void unif01_TimerSumGenWr (unif01_Gen *gen, long n, lebool fU01)+{+   unif01_TimerRec timer;+   unif01_TimerSumGen (gen, &timer, n, fU01);+   unif01_WriteTimerRec (&timer);+}
+ cbits/testu/src/util.c view
@@ -0,0 +1,179 @@+/*************************************************************************\+ *+ * Package:        MyLib+ * File:           util.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "util.h"++#include <stdio.h>+#include <stdlib.h>+#include <errno.h>+#include <string.h>+++#define MAXCAR 256                      /* Max length of a line of data */++++/************************************************************************/++FILE *util_Fopen (const char *path, const char *mode)+{+   FILE *f;+   errno = 0;+   f = fopen (path, mode);+   if (f == NULL) {+      fprintf (stdout, "\nOpening of %s failed: %s\n\n",+               path, strerror (errno));+      exit (EXIT_FAILURE);+      return NULL;     /* to eliminate a warning from the compiler */+   } else+      return f;+}++int util_Fclose (FILE * f)+{+   int s;+   if (f == NULL)+      return 0;+   errno = 0;+   s = fclose (f);+   if (s != 0)+      fprintf (stdout, "\nClosing of file failed: %s\n\n", strerror (errno));+   return s;+}+++/************************************************************************/++void *util_Malloc (size_t size)+{+   void *p;+   errno = 0;+   p = malloc (size);+   if (p == NULL) {+      fprintf (stdout, "\nmalloc failed: %s\n\n", strerror (errno));+      exit (EXIT_FAILURE);+      return NULL;     /* to eliminate a warning from the compiler */+   } else+      return p;+}++void *util_Calloc (size_t count, size_t esize)+{+   void *p;+   errno = 0;+   p = calloc (count, esize);+   if (p == NULL) {+      fprintf (stdout, "\ncalloc failed: %s\n\n", strerror (errno));+      exit (EXIT_FAILURE);+      return NULL;     /* to eliminate a warning from the compiler */+   } else+      return p;+}++void *util_Realloc (void *ptr, size_t size)+{+   void *p;+   errno = 0;+   p = realloc (ptr, size);+   if ((p == NULL) && (size != 0)) {+      fprintf (stdout, "\nrealloc failed: %s\n\n", strerror (errno));+      exit (EXIT_FAILURE);+      return ptr;      /* to eliminate a warning from the compiler */+   } else+      return p;++}++void *util_Free (void *p)+{+   free (p);+   return NULL;+}+++/************************************************************************/++void util_WriteBool (lebool b, int d)+{+   if (b)+      printf ("%*s", d, "TRUE");+   else+      printf ("%*s", d, "FALSE");+}+++void util_ReadBool (char S[], lebool *x)+{+   int j;+   char B[6];+   j = sscanf (S, " %6s", B);+   util_Assert (j > 0, "util_ReadBool:   on reading lebool");+   if (!strncmp (B, "TRUE", (size_t) 5))+      *x = TRUE;+   else if (!strncmp (B, "FALSE", (size_t) 6))+      *x = FALSE;+   else {+      util_Error ("util_ReadBool:   lebool values must be TRUE or FALSE");+   }+}+++/************************************************************************/++int util_GetLine (FILE *infile, char *Line, char c)+{+   size_t j;++   while (NULL != fgets (Line, MAXCAR, infile)) { /* Not EOF and no error */+     /* Find first non-white character in Line */+     j = strspn (Line, " \t\r\f\v");+     /* Discard blank lines and lines whose first non-white character is c */+     if (Line[j] == '\n' ||  Line[j] == c) +        continue;+     else {+        char *p;+        /* If the character c appears, delete the rest of the line*/+        if ((p = strchr (Line, c)))+	   *p = '\0';++        else {+        /* Remove the \n char at the end of line */+           j = strlen (Line);+           if (Line[j - 1] == '\n')+	      Line[j - 1] = '\0';+	}+        return 0;+     }+   }++   util_Fclose (infile);+   return -1;+   /*  util_Error ("GetLine: an error has occurred on reading"); */+}
+ cbits/testu/src/vectorsF2.c view
@@ -0,0 +1,1089 @@+#include "vectorsF2.h"+#include <stdio.h>+#include <stdlib.h>++#define WL vectorsF2_WL++#define MC 0x80000000UL    /* permet de diagonaliser la matrice dans Diag() */++unsigned long MMC[WL] =+   { MC, MC >> 1, MC >> 2, MC >> 3, MC >> 4, MC >> 5, MC >> 6, MC >> 7,+   MC >> 8, MC >> 9, MC >> 10,+   MC >> 11, MC >> 12, MC >> 13, MC >> 14, MC >> 15, MC >> 16, MC >> 17,+   MC >> 18, MC >> 19, MC >> 20,+   MC >> 21, MC >> 22, MC >> 23, MC >> 24, MC >> 25, MC >> 26, MC >> 27,+   MC >> 28, MC >> 29, MC >> 30, MC >> 31+};++lebool InverseMatrix (Matrix * InvM, Matrix * M)+{++   Matrix Temp;+   int j, rang;+   if (M->nblignes != M->l) {+      printf ("Matrix M is not square!\n");+      exit (1);+   }+   AllocMat (&Temp, M->nblignes, M->l, 2);+   for (j = 0; j < M->l; j++)+      CopyBV (&(Temp.lignes[j][0]), &(M->lignes[j][0]));+   for (j = 0; j < M->l; j++) {+      BVCanonic (&(Temp.lignes[j][1]), j);+   }+   /* DispMat(&Temp,2,M->l,M->nblignes,0); */+   rang = CompleteElimination (&Temp, M->nblignes, M->l, 2);+   /* DispMat(&Temp,2,M->l,M->nblignes,0); */+   /* printf("rang=%d",rang); */+   for (j = 0; j < M->l; j++)+      CopyBV (&(InvM->lignes[j][0]), &(Temp.lignes[j][1]));+   return (rang == M->l);+   FreeMat (&Temp);+}+++/* ********************************************************************** */+/* lebool Diag( Matrix m, int kg,				          */+/*               int t, int l, int *gr )                                  */+/* Evalue si la matrice de travail m sur kg lignes est de plein rang en   */+/* la diagonalisant.  On procede sur t BitVect en considerant les l       */+/* premiers bits de chacun.  La fonction retourne TRUE si la matrice m    */+/* est de plein rang t*l et *gr est inchange. La fonction retourne        */+/* FALSE sinon et *gr prend pour valeur le numero du BitVect ou il y a    */+/* eu echec moins un ( = dimension pour laquelle on a resolution l ).     */+/* ********************************************************************** */+lebool Diag (Matrix * m, int kg, int t, int l, int *gr)+{+   int i, j, cl, rang;++   rang = 0;++   /* On diagonalise la matrice des entrees (i,j) sur l bits */+   /* avec 0 <= i < kg et 0 <= j < t .  */++   for (j = 0; j < t; j++) {+      cl = 1;+      while (cl <= l) {+         /* On cherche dans la j-eme colonne, commencant a la */+         /* rang-eme ligne, la premiere entree dont le bit le plus */+         /* significatif est non nul.  Bref, on cherche un pivot.  */+         i = rang;++         while ((i < kg)+            && (m->lignes[i][j].vect[(cl - 1) / WL] < MMC[(cl - 1) % WL]))+            i++;+         if (i < kg) {            /* pivot trouve ... */+            ExchangeVect (m, rang, i);+            for (i = rang + 1; i < kg; i++) {+               if (m->lignes[i][j].vect[(cl - 1) / WL] & MMC[(cl - 1) % WL])+                  XorVect (m, i, rang, j, m->t);+            }+            rang++;+         } else {                 /* pas de pivot trouve ... ==> pas de plein+                                     rang ... */++            *gr = j;              /* no de groupe ou il y a echec moins un */+            return FALSE;         /* c'est j car on indexe a partir de 0 .  */+         }+         cl++;+      }+   }+   return TRUE;                   /* on a trouve tous les pivots ==> plein+                                     rang ! */+}+++int CompleteElimination (Matrix * m, int nblignes, int l, int t)+{+   int i, j, cl, rang;++   rang = 0;++   j = 0;+   while (j < t) {+      cl = 0;+      while (cl < l) {+         /* On cherche dans la j-eme colonne, commencant a la */+         /* rang-eme ligne, la premiere entree dont le bit le plus */+         /* significatif est non nul.  Bref, on cherche un pivot.  */+         i = rang;+         while ((i < nblignes)+            && ((((m->lignes)[i])[j]).vect[(cl) / WL] < MMC[(cl) % WL]))+            i++;+         if (i < nblignes) {      /* pivot trouve ... */+            ExchangeVect (m, rang, i);+            for (i = 0; i < nblignes; i++)+               if (i != rang)+                  if ((((m->lignes)[i])[j]).vect[(cl) / WL] & MMC[(cl) % WL])+                     XorVect (m, i, rang, 0, m->t);++            rang++;+            if (rang == nblignes)+               return rang;+         } else+            return rang;+         cl++;+      }+      j++;+   }+   return rang;+}+++int GaussianElimination (Matrix * m, int nblignes, int l, int t)+{+   int i, j, cl, rang;++   rang = 0;++   j = 0;+   while (j < t) {+      cl = 0;+      while (cl < l) {+         /* On cherche dans la j-eme colonne, commencant a la */+         /* rang-eme ligne, la premiere entree dont le bit le plus */+         /* significatif est non nul.  Bref, on cherche un pivot.  */+         i = rang;+         while ((i < nblignes)+            && ((((m->lignes)[i])[j]).vect[(cl) / WL] < MMC[(cl) % WL]))+            i++;+         if (i < nblignes) {      /* pivot trouve ... */+            ExchangeVect (m, rang, i);+            for (i = rang + 1; i < nblignes; i++)+               if ((((m->lignes)[i])[j]).vect[(cl) / WL] & MMC[(cl) % WL])+                  XorVect (m, i, rang, 0, m->t);++            rang++;+            if (rang == nblignes)+               return rang;+         }+         cl++;+      }+      j++;+   }+   return rang;+}+++int SpecialGaussianElimination (Matrix * m, int nblignes, int l, int t,+   int *indices)+{+   int i, j, cl, rang;++   rang = 0;++   j = 0;+   while (j < t) {+      cl = 0;+      while (cl < l) {+         /* On cherche dans la j-eme colonne, commencant a la */+         /* rang-eme ligne, la premiere entree dont le bit le plus */+         /* significatif est non nul.  Bref, on cherche un pivot.  */+         i = rang;+         while ((i < nblignes)+            && ((((m->lignes)[i])[indices[j]]).vect[(cl) / WL] <+               MMC[(cl) % WL]))+            i++;+         if (i < nblignes) {      /* pivot trouve ... */+            ExchangeVect (m, rang, i);+            for (i = rang + 1; i < nblignes; i++)+               if ((((m->lignes)[i])[indices[j]]).vect[(cl) /+                     WL] & MMC[(cl) % WL])+                  XorVect (m, i, rang, 0, m->t);++            rang++;+            if (rang == nblignes)+               return rang;+         }+         cl++;+      }+      j++;+   }+   return rang;+}+++void MultMatrixByBV (BitVect * A, Matrix * M, BitVect * B)+{+   int i, j, res;+   if (M->l < B->n * WL) {+      printf ("Error in MultMatrixByBV(): sizes do not match\n");+      exit (1);+   }+   if (A->n * WL < M->nblignes) {+      printf ("Error in MultMatrixByBV(): sizes do not match\n");+      exit (1);+   }+   if (M->t != 1) {+      printf ("Error in MultMatrixByBV(): Not implemented for M->t > 1\n");+      exit (1);+   }+   PutBVToZero (A);+   for (i = 0; i < M->nblignes; i++) {+      res = 0;+      for (j = 0; j < M->l; j++)+         res += ValBitBV (&(M->lignes[i][0]), j) * ValBitBV (B, j);+      res %= 2;+      PutBitBV (A, i, res);+   }+}+++/* ********************************************************************** */+/* int GetBitBV (BitVect A, int noBit)			  */+/* Fonction qui permet de prendre la valeur du noBit-ieme bit             */+/* (l'indexation commence au bit 0)					  */+/* ********************************************************************** */+int ValBitBV (BitVect * A, int noBit)+{+   int k;+   unsigned long mask;+   k = noBit / WL;+   mask = 0x80000000UL >> (noBit - k * WL);+   if (A->vect[k] & mask)+      return 1;+   else+      return 0;+}+++/* ********************************************************************** */+/* void SetBitBV (BitVect A, int noBit, int valBit)		  */+/* Fonction qui permet de rendre la valeur du noBit-ieme bit `a valBit     */+/* (l'indexation commence au bit 0) (valBit=1 ou valBit=0)		  */+/* ********************************************************************** */+void PutBitBV (BitVect * A, int noBit, int valBit)+{+   int k;+   unsigned long mask;++   k = noBit / WL;+   if (valBit == 1) {+      mask = 0x80000000UL >> (noBit - k * WL);+      A->vect[k] |= mask;+   } else {+      mask = 0xffffffffUL ^ (0x80000000UL >> (noBit - k * WL));+      A->vect[k] &= mask;+   }+}+++/* ********************************************************************** */+/* SetBVToZero( BitVect A)        					  */+/* Initialise le vecteur de bit a zero       				  */+/* ********************************************************************** */+void PutBVToZero (BitVect * A)+{+   int i;+   for (i = 0; i < A->n; i++)+      A->vect[i] = 0UL;+}+++/* ********************************************************************** */+/* void CopyBV(BitVect A, BitVect B)       				  */+/* Copie le contenu de B dans A (A=B)       				  */+/* ********************************************************************** */+void CopyBV (BitVect * A, BitVect * B)+{+   int i;++   if (A->n != B->n) {+      printf+    ("Error in CopyBV(): vectors of different dimensions! (%d and %d bits)\n",+         A->n * WL, B->n * WL);+      exit (1);+   }++   if (B->n == 0) {+      printf ("Nothing to copy!\n");+      exit (1);+   }+   for (i = 0; i < B->n; i++)+      A->vect[i] = B->vect[i];+}+void CopyBVPart (BitVect * A, BitVect * B, int l)+{++   int i, n;++   n = (l - 1) / WL + 1;++   if (A->n < n) {+      printf ("Error in CopyBVPart() : The vector A is not large enough!\n");+      exit (1);+   }+   if (B->n == 0) {+      printf ("Nothing to copy!\n");+      exit (1);+   }++   for (i = 0; i < n; i++)+      A->vect[i] = B->vect[i];++   if (l % WL) {+      BitVect m;+      AllocBV (&m, A->n * WL);+      Mask (&m, l);+      ANDBVSelf (A, &m);+      FreeBV (&m);+   }+}+++/* ********************************************************************** */+/* void EgalBV(BitVect A, BitVect B)       				  */+/* Compare le contenu de B avec celui de A.  Retourne TRUE si les deux    */+/* contiennent la meme information.       				  */+/* ********************************************************************** */+lebool CompareBV (BitVect * A, BitVect * B)+{++   int i;++   if (A->n != B->n) {+      printf ("Error in EgalBV(): Vectors of different sizes\n");+      exit (1);+   }++   for (i = 0; i < A->n; i++)+      if (A->vect[i] != B->vect[i])+         return FALSE;+   return TRUE;+}+++lebool BVisZero (BitVect * A)+{+   int j = 0;+   while (j < A->n)+      if (A->vect[j++] != 0UL)+         return FALSE;+   return TRUE;+}+++/* ********************************************************************** */+/* void XORBV(BitVect A, BitVect B, BitVect C)      			  */+/* Cette fonction effectue A = B ^ C       				  */+/* ********************************************************************** */+void XORBV (BitVect * A, BitVect * B, BitVect * C)+{++   int i;++   if ((A->n != B->n) || (B->n != C->n)) {+      printf ("Error in XORBV(): Vectors of different sizes\n");+      exit (1);+   }++   for (i = 0; i < B->n; i++)+      A->vect[i] = B->vect[i] ^ C->vect[i];+}+++/* ********************************************************************** */+/* void XOR2BV(BitVect A, BitVect B, BitVect C, BitVect D)    		  */+/* Cette fonction effectue A = B ^ C ^ D      				  */+/* ********************************************************************** */+void XOR2BV (BitVect * A, BitVect * B, BitVect * C, BitVect * D)+{++   int i;++   if ((A->n != B->n) || (B->n != C->n) || (C->n != D->n)) {+      printf ("Error in XOR2BV(): Vectors of different sizes\n");+      exit (1);+   }++   for (i = 0; i < B->n; i++)+      A->vect[i] = B->vect[i] ^ C->vect[i] ^ D->vect[i];+}+++/* ********************************************************************** */+/* void ANDBV(BitVect A, BitVect B, BitVect C)      			  */+/* Cette fonction effectue A = B & C       				  */+/* ********************************************************************** */+void ANDBV (BitVect * A, BitVect * B, BitVect * C)+{++   int i;++   if ((A->n != B->n) || (B->n != C->n)) {+      printf ("Error in ANDBV(): Vectors of different sizes\n");+      exit (1);+   }++   for (i = 0; i < B->n; i++)+      A->vect[i] = B->vect[i] & C->vect[i];+}+++void ANDBVMask (BitVect * A, BitVect * B, int t)+{+   int n, m, j;+   if (A->n != B->n) {+      printf ("Error in ANDBVMask(): Vectors of different sizes\n");+      exit (1);+   }++   if (t > B->n * WL)+      CopyBV (A, B);+   else if (t == 0)+      PutBVToZero (A);+   else {+      n = t / WL;+      m = t - n * WL;+      for (j = 0; j < n; j++) {+         A->vect[j] = B->vect[j];++      }+      if (m != 0) {+         A->vect[j] = B->vect[j] & (0xffffffffUL << (WL - m));+         j++;+      }+      /* printf("n=%d j=%d %d m=%d ",n,j,A->n,m); */+      for (; j < A->n; j++) {+         A->vect[j] = 0UL;+      }+   }+}+++void ANDBVInvMask (BitVect * A, BitVect * B, int t)+{+   int n, m, j;+   if (A->n != B->n) {+      printf ("Error in ANDBV(): Vectors of different sizes\n");+      exit (1);+   }+   if (t > B->n * WL)+      PutBVToZero (A);+   else if (t == 0)+      CopyBV (A, B);+   else {+      n = t / WL;+      m = t - n * WL;+      for (j = 0; j < n; j++)+         A->vect[j] = 0UL;+      if (m == 0)+         A->vect[j] = B->vect[j];+      else {+         A->vect[j] = B->vect[j] & (0xffffffffUL >> m);++      }+      j++;+      for (; j < A->n; j++)+         A->vect[j] = B->vect[j];+   }+}+++++/* ********************************************************************** */+/* void ANDBVSelf(BitVect A, BitVect B)       				  */+/* Cette fonction effectue A &=B     					  */+/* ********************************************************************** */+void ANDBVSelf (BitVect * A, BitVect * B)+{+   int i;++   if ((A->n != B->n)) {+      printf ("Error in ANDBVSelf(): Vectors of different sizes\n");+      exit (1);+   }++   for (i = 0; i < B->n; i++)+      A->vect[i] &= B->vect[i];+}+++/* ********************************************************************** */+/* void XORBVSelf(BitVect A, BitVect B)     				  */+/* Cette fonction effectue A ^=B    					  */+/* ********************************************************************** */+void XORBVSelf (BitVect * A, BitVect * B)+{+   int i;++   if ((A->n != B->n)) {+      printf ("Error in XORBVSelf(): Vectors of different sizes\n");+      exit (1);+   }++   for (i = 0; i < B->n; i++)+      A->vect[i] ^= B->vect[i];+}+++/* ********************************************************************** */+/* void BVLShift( BitVect R, BitVect A, int n )                      */+/* Effectue : R = A << n ;                                                */+/* ********************************************************************** */+void BVLShift (BitVect * R, BitVect * A, int n)+{+   int i;+   int WLmn;+   unsigned long temp;++   if ((R->n != A->n)) {+      printf ("Error in BVLShift(): Vectors of different sizes\n");+      exit (1);+   }++   for (i = 0; i < A->n; i++)+      R->vect[i] = A->vect[i];+   while (n >= 32) {+      for (i = 1; i < A->n; i++)+         R->vect[i - 1] = R->vect[i];+      R->vect[A->n - 1] = 0UL;+      n -= 32;+   }+   if (n > 0) {+      WLmn = WL - n;+      R->vect[0] <<= n;+      for (i = 1; i < A->n; i++) {+         temp = R->vect[i] >> WLmn;+         R->vect[i - 1] |= temp;+         R->vect[i] <<= n;+      }+   }++}+++/* ********************************************************************** */+/* void BVRShift( BitVect R, BitVect A, int n )                      */+/* Effectue : R = A >> n ;                                                */+/* ********************************************************************** */+void BVRShift (BitVect * R, BitVect * A, int n)+{+   int i;+   int WLmn;+   unsigned long temp;+   if ((R->n != A->n)) {+      printf ("Error in BVRShift(): Vectors of different sizes\n");+      exit (1);+   }++   for (i = 0; i < A->n; i++)+      R->vect[i] = A->vect[i];+   while (n >= 32) {+      for (i = A->n; i > 1; i--)+         R->vect[i - 1] = R->vect[i - 2];+      R->vect[0] = 0UL;+      n -= 32;+   }+   if (n > 0) {+      WLmn = WL - n;+      R->vect[A->n - 1] >>= n;+      for (i = A->n - 2; i >= 0; i--) {+         temp = R->vect[i] << WLmn;+         R->vect[i + 1] |= temp;+         R->vect[i] >>= n;+      }+   }+}+++/* ********************************************************************** */+/* void BVLShiftSelf( BitVect R, int n )                             */+/* Effectue : R <<= n ;                                                   */+/* ********************************************************************** */+void BVLShiftSelf (BitVect * R, int n)+{+   int i;+   int WLmn;+   unsigned long temp;++   while (n >= 32) {+      for (i = 1; i < R->n; i++)+         R->vect[i - 1] = R->vect[i];+      R->vect[R->n - 1] = 0UL;+      n -= 32;+   }+   if (n > 0) {+      WLmn = WL - n;+      R->vect[0] <<= n;+      for (i = 1; i < R->n; i++) {+         temp = R->vect[i] >> WLmn;+         R->vect[i - 1] |= temp;+         R->vect[i] <<= n;+      }+   }+}+++/* ********************************************************************** */+/* void BVLS1Self( BitVect R )                                            */+/* Effectue : R <<= 1 ;                                                   */+/* Version specialisee de BVLShiftSelf pour utilisation frequente.        */+/* ********************************************************************** */+void BVLS1Self (BitVect * R)+{+   int i;+   R->vect[0] <<= 1;+   for (i = 1; i < R->n; i++) {+      if (R->vect[i] & MC)+         R->vect[i - 1] |= 0x1UL;+      R->vect[i] <<= 1;+   }+}+++/* ********************************************************************** */+/* void BVRShiftSelf( BitVect R, int n )                             */+/* Effectue : R >>= n ;                                                   */+/* ********************************************************************** */+void BVRShiftSelf (BitVect * R, int n)+{+   int i;+   int WLmn;+   unsigned long temp;++   while (n >= 32) {+      for (i = R->n - 1; i > 0; i--)+         R->vect[i] = R->vect[i - 1];+      R->vect[0] = 0UL;+      n -= 32;+   }+   if (n > 0) {+      WLmn = WL - n;+      R->vect[R->n - 1] >>= n;+      for (i = R->n - 2; i >= 0; i--) {+         temp = R->vect[i] << WLmn;+         R->vect[i + 1] |= temp;+         R->vect[i] >>= n;+      }+   }+}+++/* ********************************************************************** */+/* void invertBV(Bitvect A)                                               */+/* fait A ~=A                                                             */+/* ********************************************************************** */+void InverseBV (BitVect * A)+{+   int i;+   for (i = 0; i < A->n; i++)+      A->vect[i] = ~A->vect[i];+}+++/* ********************************************************************** */+/* lebool CheckCD( BitVect ds1, BitVect ds2 )                            */+/* Verifie si les ensembles ds1 et ds2 ont des bits communs.              */+/* ********************************************************************** */+lebool VerifBitsCommuns (BitVect * ds1, BitVect * ds2)+{+   int i;+   unsigned long temp = 0UL;+   if ((ds1->n != ds2->n)) {+      printf ("Error in VerifBitsCommuns(): Vectors of different sizes\n");+      exit (1);+   }+   for (i = 0; i < ds1->n; i++)+      temp |= (ds1->vect[i] & ds2->vect[i]);+   if (temp)+      return TRUE;+   else+      return FALSE;+}+++/* -------------------------------------------- */+/* Fonctions pour la manipulation des matrices. */+/* -------------------------------------------- */+void BVCanonic (BitVect * A, int l)+{+   int n;+   PutBVToZero (A);+   n = l / WL;+   if (n > A->n) {+      printf+         ("Error in  BVCanonic(): vector A is not long enough to store  BVCanonic[%d].\n",+         l);+      exit (1);+   }+   A->vect[n] = 0x80000000UL >> (l - n * WL);+}++void Mask (BitVect * A, int l)+{++   InvMask (A, l);+   InverseBV (A);+}++void InvMask (BitVect * A, int l)+{+   AllOnes (A);+   BVRShiftSelf (A, l);+}++void AllOnes (BitVect * A)+{+   int i;+   for (i = 0; i < A->n; i++)+      A->vect[i] = 0xffffffffUL;+}++void AllocBV (BitVect * A, int l)+{+   int n;+   n = (l - 1) / WL + 1;+   A->vect = (unsigned long *) calloc ((size_t) n, sizeof (unsigned long));+   A->n = n;+}++void FreeBV (BitVect * A)+{+   if (A->vect != NULL) {+      free (A->vect);+   }+   A->n = 0;+}++void AllocMat (Matrix * m, int nblines, int l, int t)+{+   int i, j;+   m->lignes = (BitVect **) calloc ((size_t) nblines, sizeof (BitVect *));+   for (i = 0; i < nblines; i++) {+      if (!(m->lignes[i] = (BitVect *) calloc ((size_t) t, sizeof (BitVect)))) {+         printf ("\n*** Memoire insuffisante pour AllocMat() ! nl=%d***\n",+            nblines);+         exit (1);+      }+      for (j = 0; j < t; j++)+         AllocBV (&(m->lignes[i][j]), l);++   }+   m->nblignes = nblines;+   m->t = t;+   m->l = l;++}+++/* ********************************************************************** */+/* void FreeSpace( Matrix m, int nl )                               */+/* Libere l'espace des nl vecteurs de la matrice m.                       */+/* ********************************************************************** */+void FreeMat (Matrix * m)+{+   int i, j;+   for (i = 0; i < m->nblignes; i++) {+      for (j = 0; j < m->t; j++)+         FreeBV (&(m->lignes[i][j]));+      free (m->lignes[i]);+   }+   free (m->lignes);+   m->nblignes = 0;+   m->l = 0;+   m->t = 0;++}+++/* ********************************************************************** */+/* void CopyMat( Matrix m, Matrix ms, int nl, int t )                   */+/* Cette procedure sert a copier les t premiers BitVect des nl premieres  */+/* lignes de la matrice ms dans la matrice de travail m.                  */+/* ********************************************************************** */+void CopyMat (Matrix * m, Matrix * ms, int nl, int t)+{+   int i, j;+   if (m == NULL) {+      AllocMat (m, ms->nblignes, ms->l, ms->t);+   } else if ((ms->nblignes < nl) || (ms->t < t)) {+      printf ("Error in CopyMat(): source matrix too small %d\n",+         ms->nblignes / ms->t);+      exit (1);+   } else if ((m->nblignes < nl) || (m->t < t)) {+      printf ("Error in CopyMat(): destination matrix too small\n");+      exit (1);+   }+   for (i = 0; i < nl; i++)+      for (j = 0; j < t; j++) {+         CopyBV (&(m->lignes[i][j]), &(ms->lignes[i][j]));+      }+}+++/* ********************************************************************** */+/* void CopyNTupleMat( Matrix m, Matrix ms, int nl,     */+/*                     int *colonnes, int t )                   */+/* Cette procedure sert a copier les t-1 BitVect indiqu'es par le vecteur  */+/* *colonnes plus la colonne 0 des nl premieres lignes de la matrice ms   */+/* dans la matrice de travail m.       */+/* ********************************************************************** */+void CopyNTupleMat (Matrix * m, Matrix * ms, int nl, int *colonnes, int t)+{++   int i, j, k, n;++   if (m == NULL)+      AllocMat (m, ms->nblignes, ms->l, t);+   else {+      if ((ms->nblignes != m->nblignes) || (ms->l != m->l))+         printf ("Error in CopieNTupleMat(): matrices of different sizes\n");+   }+   n = (ms->l - 1) / WL;+   for (i = 0; i < nl; i++) {+      for (k = 0; k <= n; k++)+         (m->lignes[i])[0].vect[k] = (ms->lignes[i])[0].vect[k];+      for (j = 1; j < t; j++)+         for (k = 0; k <= n; k++)+            (m->lignes[i])[j].vect[k] =+               (ms->lignes[i])[colonnes[j - 1]].vect[k];++   }+}+++/* ********************************************************************** */+/* void SwapVect( Matrix m, int i, int j )                     */+/* Pour interchanger les lignes i et j de la matrice de travail m.        */+/* ********************************************************************** */+void ExchangeVect (Matrix * m, int i, int j)+{+   BitVect *p;+   if (i != j) {+      p = m->lignes[i];+      m->lignes[i] = m->lignes[j];+      m->lignes[j] = p;+   }+}+++void TransposeMatrices (Matrix * T, Matrix * M, int mmax, int smax, int L)+{++   int s, l, m;++   for (s = 0; s < smax; s++)+      for (l = 0; l < L; l++) {+         PutBVToZero (&T->lignes[l][s]);+         for (m = 0; m < mmax; m++) {+            /* printf("m=%d l=%d s=%d\n",m,l,s);fflush(stdout); */+            if (M->lignes[m][s].vect[0] & (0x80000000UL >> l)) {+               T->lignes[l][s].vect[0] |= (0x80000000UL >> m);+            }+         }+      }+}+++/* ********************************************************************** */+/* void XorVect( Matrix m,                                               */+/*               int r, int s, int min, int max )     */+/* Effectue un Xor entre la s-eme et la r-eme ligne de la matrice de      */+/* travail m pour les colonnes (BitVect) min a max-1 seulement.           */+/* Le resultat est mis dans la r-eme ligne. ( m[r] ^= m[s] )              */+/* ********************************************************************** */+void XorVect (Matrix * m, int r, int s, int min, int max)+{+   int j;+   for (j = min; j < max; j++)+      XORBVSelf (&(m->lignes[r][j]), &(m->lignes[s][j]));+}+++/* ********************************************************************** */+/* void displaymat(Matrix m, int t, int l, int kg)        */+/* Affiche la matrice m sur kg lignes par t x l colonnes  		  */+/* ********************************************************************** */+void DispMat (Matrix * m, int t, int l, int kg, lebool mathematica)+{+   int i, j;++   i = kg;++   printf ("\n");+   if (mathematica)+      printf ("{");+   for (i = 0; i < kg; i++) {+      if (!mathematica)+         printf ("[");+      for (j = 0; j < t; j++) {+         DispBitVect (&(m->lignes[i][j]), l, mathematica);+      }+      if (mathematica) {+         if (i != kg - 1)+            printf (",\n");+         else+            printf ("}\n");+      } else+         printf ("]\n");+   }+   printf ("\n\n");++}+++/* ********************************************************************** */+/* void displaybitvect(BitVect A, int l)    			  */+/* Affiche le BitVect A sur l bits seulement    			  */+/* ********************************************************************** */+void DispBitVect (BitVect * A, int l, int mathematica)+{+   int j;+   unsigned Un;+   Un = 1UL;+   j = 0;+   if (mathematica) {+      printf ("{");+      while (j < l - 1) {+         printf ("%ld,",+            (A->vect[j / WL] >> (((WL * A->n) - j - 1) % WL)) & Un);+         j++;+      }+      printf ("%ld}", (A->vect[j / WL] >> (((WL * A->n) - j - 1) % WL)) & Un);+   } else+      while (j < l) {+         printf ("%ld",+            (A->vect[j / WL] >> (((WL * A->n) - j - 1) % WL)) & Un);+         j++;+      }+}+++/* ********************************************************************** */+/* MultMatrixByMatrix ( Matrix *A, Matrix *B, Matrix *C)        	  */+/* Fait la multiplication matricielle A = B x C    			  */+/* ********************************************************************** */++void MultMatrixByMatrix (Matrix * A, Matrix * B, Matrix * C)+{+   int i, j;+   if (B->l != C->nblignes) {+      printf ("Tailles de matrices non-compatibles, kaput.\n");+      exit (1);+   }++   if (A->nblignes != B->nblignes || A->l != C->l) {+      printf ("Matrice preallouee de mauvaise taille.\n");+      exit (1);+   }++   for (i = 0; i < A->nblignes; i++)+      PutBVToZero (A->lignes[i]);++   for (i = 0; i < B->nblignes; i++)+      for (j = 0; j < B->l; j++) {+         if (ValBitBV (B->lignes[i], j))+            XORBVSelf (A->lignes[i], C->lignes[j]);+      }+}+++/* ********************************************************************** */+/* MatrixTwoPow ( Matrix *A, Matrix *B, unsigned int e)          	  */+/* Fait l'exponentiation : A = B^(2^e)          			  */+/* ********************************************************************** */++void MatrixTwoPow (Matrix * A, Matrix * B, unsigned int e)+{+   unsigned int i;+   Matrix tempMatrix;+   Matrix *AA = &tempMatrix;++   if (B->nblignes != B->l) {+      printf ("Matrice non carree.\n");+      exit (1);+   }+   if (A->nblignes != B->nblignes || A->l != B->l) {+      printf ("Matrice preallouee de mauvaise taille.\n");+      exit (1);+   }++   AllocMat (AA, B->nblignes, B->l, 1);++   if (e == 0) {+      CopyMat (A, B, B->nblignes, 1);+      return;+   }+   /* A = B^(2^1) */+   MultMatrixByMatrix (A, B, B);++   for (i = 1; i < e - 1; i += 2) {+     /* AA = A * A */+      MultMatrixByMatrix (AA, A, A);++      /* A = AA * AA */+      MultMatrixByMatrix (A, AA, AA);+   }++   if (i == e - 1) {+     /* AA = A * A */+      MultMatrixByMatrix (AA, A, A);+      CopyMat (A, AA, AA->nblignes, 1);+   }++   FreeMat (AA);+}++/* ********************************************************************** */+/* MatrixPow ( Matrix *A, Matrix *B, unsigned int e)            	  */+/* Fait l'exponentiation : A = B^e               			  */+/* ********************************************************************** */++#ifdef USE_LONGLONG+void MatrixPow (Matrix * A, Matrix * B, longlong e)+#else+void MatrixPow (Matrix * A, Matrix * B, long e)+#endif+{+   int i;+   Matrix C;+   Matrix D;++   if (B->nblignes != B->l) {+      printf ("Matrice non carree.\n");+      exit (1);+   }++   if (A->nblignes != B->nblignes || A->l != B->l) {+      printf ("Matrice preallouee de mauvaise taille.\n");+      exit (1);+   }++   AllocMat (&C, B->nblignes, B->l, 1);++   if (e < 0) {+      InverseMatrix (&C, B);+      MatrixPow (A, &C, -e);+      FreeMat (&C);+      return;+   }+   AllocMat (&D, B->nblignes, B->l, 1);++   /* A = I */+   for (i = 0; i < A->nblignes; i++)+      BVCanonic (A->lignes[i], i);++   /* C = B^1 */+   CopyMat (&C, B, B->nblignes, 1);++   while (e) {+      if (e & 1) {+         CopyMat (&D, A, B->nblignes, 1);+         MultMatrixByMatrix (A, &D, &C);+      }++      e >>= 1;++      if (e) {+         CopyMat (&D, &C, B->nblignes, 1);+         MultMatrixByMatrix (&C, &D, &D);+      }+   }++   FreeMat (&C);+   FreeMat (&D);+}+++/* FIN vectorsF2.c */
+ cbits/testu/src/wdist.c view
@@ -0,0 +1,55 @@+/*************************************************************************\+ *+ * Package:        ProbDist+ * File:           wdist.c+ * Environment:    ANSI C+ *+ * Copyright (c) 2002 Pierre L'Ecuyer, DIRO, Université de Montréal.+ * e-mail: lecuyer@iro.umontreal.ca+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted without a fee for private, research,+ * academic, or other non-commercial purposes.+ * Any use of this software in a commercial environment requires a+ * written licence from the copyright owner.+ *+ * Any changes made to this package must be clearly identified as such.+ *+ * In scientific publications which used this software, a reference to it+ * would be appreciated.+ *+ * Redistributions of source code must retain this copyright notice+ * and the following disclaimer.+ *+ * THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.+ *+\*************************************************************************/++#include "wdist.h"+#include "fdist.h"++++/*=========================================================================*/++double wdist_Normal (double Junk[], double x)+{+   return fdist_Normal2 (x);+}+++double wdist_ChiSquare (double W[], double x)+{+   long N = (long) W[0];+   return fdist_ChiSquare2 (N, 12, x);+}+++double wdist_Unif (double Junk[], double x)+{+   return fdist_Unif (x);+}+
+ htestu.cabal view
@@ -0,0 +1,44 @@+-- Initial htestu.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++name:                htestu+version:             0.1.0.0+synopsis:            A library for testing correctness of pseudo random number generators in Haskell.+description:+  HTestU is a library for testing correctness of presudo random number generators (PRNGs) written in Haskell.+  HTestU uses a library TestU01 based on a paper "TestU01: A C Library for Empirical Testing of Random Number Generators" by P. L'Ecuyer and R. Simard.+  Basically HTestU performs a wrapping of a member of the RandomGen typeclass (any reasonable PRNG can be made a member of it) and+  feeds a wrapped generator into a C library which calls the wrapped generator to fill the buffer with pseudo random numbers and then+  perform tests on the generated numbers.++  HTestU offers three batteries: smallCrush, crush and bigCrush (as they were specified in TestU01 paper) and a number of+  streaming functions which allow one to wrap the PRNG differently for the purpose of testing different patterns of PRNG usage.++homepage:            https://github.com/nkartashov/htestu+license:             MIT+license-file:        LICENSE+author:              Nikita Kartashov+maintainer:          snailandmail@gmail.com+category:            System+build-type:          Simple+cabal-version:       >=1.10++source-repository head+    type:     git+    location: https://github.com/idontgetoutmuch/htestu++library+  exposed-modules:     Test.HTestU,+                       Test.HTestU.Streaming,+                       Test.HTestU.BatteryResult,+                       Test.HTestU.Wrapping+  other-extensions:    ForeignFunctionInterface, CPP+  build-depends:       base >=4.7 && < 4.10,+                       random++  hs-source-dirs:      src+  build-tools:         gcc, hsc2hs+  default-language:    Haskell2010+  include-dirs: cbits/testu/include+  c-sources: cbits/testu/src/util.c cbits/testu/src/chrono.c cbits/testu/src/bitset.c cbits/testu/src/num.c cbits/testu/src/num2.c cbits/testu/src/mystr.c cbits/testu/src/tables.c cbits/testu/src/statcoll.c cbits/testu/src/gofs.c cbits/testu/src/gofw.c cbits/testu/src/gdef.c cbits/testu/src/vectorsF2.c cbits/testu/src/swrite.c cbits/testu/src/wdist.c cbits/testu/src/smultin.c cbits/testu/src/svaria.c cbits/testu/src/swalk.c cbits/testu/src/sstring.c cbits/testu/src/sspectral.c cbits/testu/src/sres.c cbits/testu/src/snpair.c cbits/testu/src/smarsa.c cbits/testu/src/sknuth.c cbits/testu/src/scomp.c cbits/testu/src/ftab.c cbits/testu/src/fres.c cbits/testu/src/fmass.c cbits/testu/src/fdist.c cbits/testu/src/fcho.c cbits/testu/src/fbar.c cbits/testu/src/fmarsa.c  cbits/testu/src/ufile.c cbits/testu/src/unif01.c cbits/testu/src/bbattery.c+  ghc-options:        -O2
+ src/Test/HTestU.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Test.HTestU+  ( TestResult+  , runBattery+  , toResults+  , runBatteryToResults+  , c_smallCrush+  , c_crush+  , c_bigCrush+  ) where++import System.Random (RandomGen)++import Foreign.Marshal.Alloc (free)+import Foreign.Marshal.Array (peekArray)+import Foreign.Storable (peek)+import Foreign.Ptr (freeHaskellFunPtr)++import System.IO.Unsafe (unsafePerformIO)++import Test.HTestU.Wrapping (Battery, genToWrappedCallback, c_createGenerator, c_deleteGenerator)+import Test.HTestU.BatteryResult (BatteryResultStruct(..))+import Test.HTestU.Streaming (RandomStream)++-- | Type for presenting a result of a test, instead of a p-value+data TestResult = Fail | Suspect | OK deriving (Eq, Show)++-- | P-value serving as a border for a failure in TestU01, greater => failure or suspicious value+failurePvalue :: Double+failurePvalue = 0.0000000001 -- 10^(-10)++-- | P-value serving as a border for a suspicious value in TestU01, greater => failure+suspectPvalue :: Double+suspectPvalue = 0.001 -- 10^(-3)++-- | Prettifying a p-value to a test result+pValueToResult :: Double -> TestResult+pValueToResult pvalue | pvalue < failurePvalue || pvalue > 1.0 - failurePvalue = Fail+                      | pvalue < suspectPvalue || pvalue > 1.0 - suspectPvalue = Suspect+                      | otherwise = OK++-- | Prettifying a list of result p-values+toResults :: [Double] -> [TestResult]+toResults = map pValueToResult++-- | Run a given battery and present pretty results+runBatteryToResults :: RandomGen g => (g -> RandomStream) -> g -> Battery -> [TestResult]+runBatteryToResults = ((toResults .) .) . runBattery++-- | Run a given battery and present resulting p-values+-- NOTE: returns [Double] instead of IO [Double], because it is transparent (for the same gen result should be the same)+runBattery :: RandomGen g => (g -> RandomStream) -> g -> Battery -> [Double]+runBattery streamer gen crush = unsafePerformIO $ do+  callback <- genToWrappedCallback streamer gen+  generatorPtr <- c_createGenerator callback+  batteryResult <- crush generatorPtr+  (BR ps tests) <- peek batteryResult+  c_deleteGenerator generatorPtr+  freeHaskellFunPtr callback+  free batteryResult+  cDoublePvalues <- peekArray (fromIntegral tests) ps+  return $ map realToFrac cDoublePvalues+{-# NOINLINE runBattery #-}++-- | Runs SmallCrush battery, 10 tests+foreign import ccall safe "bbattery_SmallCrush" c_smallCrush :: Battery++-- | Runs Crush battery, 96 tests+foreign import ccall safe "bbattery_Crush" c_crush :: Battery++-- | Runs BigCrush Battery, 106 tests+foreign import ccall safe "bbattery_BigCrush" c_bigCrush :: Battery
+ src/Test/HTestU/BatteryResult.hsc view
@@ -0,0 +1,34 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE CPP                      #-}++module Test.HTestU.BatteryResult+( BatteryResultStruct(..)+) where++import Foreign.C.Types (CInt(..), CDouble(..))+import Foreign.Ptr (Ptr)+import Foreign.Storable++#include "bbattery.h"++-- | Structure holding an array of p-values after performing the testing+-- and their number+data BatteryResultStruct = BR {+  pValues :: Ptr CDouble,+  testNumber :: CInt+  } deriving (Eq, Show)++#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++instance Storable BatteryResultStruct where+  sizeOf _ = (#size BatteryResult)+  alignment _ = #{alignment BatteryResult}+  peek ptr = do+    pValues <- (#peek BatteryResult, pValues) ptr+    testNumber <- (#peek BatteryResult, testNumber) ptr+    return $ BR pValues testNumber++  poke ptr (BR pValues testNumber) = do+    #{poke BatteryResult, pValues} ptr pValues+    #{poke BatteryResult, testNumber} ptr testNumber+
+ src/Test/HTestU/Streaming.hs view
@@ -0,0 +1,58 @@+module Test.HTestU.Streaming+ ( RandomStream+ , nextStreamFromGen+ , splitNextStreamFromGen+ , leftSplitStreamFromGen+ , rightSplitStreamFromGen+ ) where++import System.Random (RandomGen, next, split)+import Data.Tuple (swap)++-- | Synonym for an infinite stream of random numbers+type RandomStream = [Int]++-- | Endomorphic wrapper for 'next' function+wrappedNext :: RandomGen g => (Int, g) -> (Int, g)+wrappedNext (_, newGen) = next newGen++-- | Generates a stream from a PRNG by using a repeated 'next' application+nextStreamFromGen :: RandomGen g => g -> RandomStream+nextStreamFromGen gen = map fst $ iterate wrappedNext firstStreamElement+  where firstStreamElement = next gen++-- | Generates a stream from a PRNG by using 'split' and a provided choose function+splitStreamFromGen :: RandomGen g => ((g, g) -> (g, g)) -> g -> RandomStream+splitStreamFromGen choose gen = let (old, new) = choose $ split gen+                                    (value, _) = next old+                                     in value : splitStreamFromGen choose new++-- | Does nothing to the provided pair of generators+goLeft :: (g, g) -> (g, g)+goLeft = id++-- | Swaps the generators so they change roles+goRight :: (g, g) -> (g, g)+goRight = swap++-- | Generates a stream from a PRNG by using 'split' and a left generator to+-- produce a next random number+leftSplitStreamFromGen :: RandomGen g => g -> RandomStream+leftSplitStreamFromGen = splitStreamFromGen goLeft++-- | Generates a stream from a PRNG by using 'split' and a right generator to+-- produce a next random number+rightSplitStreamFromGen :: RandomGen g => g -> RandomStream+rightSplitStreamFromGen = splitStreamFromGen goRight++-- | Splits a provided generator and intertwines the generated random streams+splitNextStreamFromGen :: RandomGen g => g -> RandomStream+splitNextStreamFromGen gen = intertwineStreams (nextStreamFromGen leftGen) $ nextStreamFromGen rightGen+  where (leftGen, rightGen) = split gen++-- | Returns a new stream of elements in which elements from two given streams+-- alternate+intertwineStreams :: [a] -> [a] -> [a]+intertwineStreams [] ys = ys+intertwineStreams xs [] = xs+intertwineStreams (x : xs) (y : ys) = x : y : intertwineStreams xs ys
+ src/Test/HTestU/Wrapping.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Test.HTestU.Wrapping+  ( Battery+  , WrappedCallback+  , c_createGenerator+  , c_deleteGenerator+  , genToWrappedCallback+  , streamToWrappedCallback+  , randomStreamActionToWrappedCallback+  ) where++import System.Random (RandomGen)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Foreign.Ptr (Ptr, FunPtr)+import Foreign.C.Types (CUInt(..))+import Foreign.Marshal.Array (pokeArray)++import Test.HTestU.Streaming (RandomStream)+import Test.HTestU.BatteryResult (BatteryResultStruct(..))++-- | A token type of a C structure of a PRNG, is not used directly+data UniformGenerator++-- | Result of running a battery - IO action giving the caller a C struct with+-- resulting p-values describing the results of run tests+type BatteryResult = IO (Ptr BatteryResultStruct)++-- | Battery takes a wrapped generator and produces p-values as a result of its testing+type Battery = Ptr UniformGenerator -> BatteryResult++-- | Function which fills the array with numbers+-- given size and a pointer to it+type Callback = CUInt -> Ptr CUInt -> IO ()++-- | Wrapped 'Callback' function for calling from C+type WrappedCallback = FunPtr Callback++-- | C function allocating a PRNG on C side, given a callback wrapping it+foreign import ccall safe "unif01_CreateExternGenBits" c_createGenerator :: WrappedCallback -> IO (Ptr UniformGenerator)++-- | Complimentary deallocating function to 'c_createGenerator'+foreign import ccall unsafe "unif01_DeleteExternGenBits" c_deleteGenerator :: Ptr UniformGenerator -> IO ()++-- | Wrapper function for porting callback to C+foreign import ccall unsafe "wrapper" mkCallback :: Callback -> IO WrappedCallback++-- | Wraps the given RandomGen into a C callback+genToWrappedCallback :: RandomGen g => (g -> RandomStream) -> g -> IO WrappedCallback+genToWrappedCallback streamer gen = streamToWrappedCallback $ streamer gen++-- | Wraps an stream of numbers into a C callback+streamToWrappedCallback :: RandomStream -> IO WrappedCallback+streamToWrappedCallback stream = newIORef stream >>= mkCallback . nextIntFromStreamRef++-- | Wraps an stream of numbers produced by a stream of numbers into a C callback+randomStreamActionToWrappedCallback :: IO RandomStream -> IO WrappedCallback+randomStreamActionToWrappedCallback action = action >>= streamToWrappedCallback++-- | Takes an allocated reference to a stream of numbers produces a Callback+-- for passing to C code+nextIntFromStreamRef :: IORef RandomStream -> Callback+nextIntFromStreamRef streamRef (CUInt values) arrayPtr = do+  randomNumbers <- readIORef streamRef+  let (toDump, rest) = splitAt (fromIntegral values) randomNumbers+  writeIORef streamRef rest+  pokeArray arrayPtr $ map fromIntegral toDump