/*
 *	File: adjZipf.c
 *
 *      (C) IWTS
 *          KU Nijmegen
 *          The Netherlands
 *
 *      Author: R. Harald Baayen
 *
 *      History:
 *
 *      - feb 1997, version 1.0
 *
 *      Description:
 *      
 *
 */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <errno.h>
#include <malloc.h>
#include <math.h>
#include "lex_cons.h"


/* EXTERN FUNCTIONS */

/* functions for numerical procedures */

extern double	alpha1 ();
extern double	alpha2 ();
extern double	alphaRecur ();
extern double	expV ();
extern double	expVm ();
extern double	funcVm ();
extern double	qromb ();

extern void	linearfit ();
extern double	zipflink ();

extern double	**matrix ();
extern double	*vector ();
extern void	free_matrix ();
extern void	free_vector ();

/* argument reading, file manipulation, and help function */

extern int	leesgetal ();
extern double	leesdouble ();
extern void	change_extension ();
extern void	help ();


/* GLOBAL VARIABLES */

double   N, V, n1, n2,              /* number of tokens, types, hapaxes, disleg */
         corr2, correctie,       
         E,                         /* extrapolation sample size */
         pstar,                     /* maximum relative frequency */
         mmax,                      /* highest frequency rank */
         mrank,                     /* word frequency, used in expVm() */
         SPECTRUM[MAXM1][3],        /* frequency spectrum m Vm EVm */
         Z, VZ,                     /* Zipf size, and V(Z) */
         Nzero, Vzero,              /* original sample size N0 */
         eV, eV2N, S,               /* E[V(N)], E[V(2N)], S */
         CHUNKS[MAXCHUNKS3],        /* the chunk sizes */
         chunksize, remainDer,      /* chunk variables */
         x, x1, y, y2, y3, y4, y5,
         rmax,                      /* min corr r */
         Intercept, Slope,          /* intercept and slope of model */
         *t,                        /* t statistic */
         *r,                        /* correlation coefficient */
         *a,                        /* coefficients of linear model */
         *b,
         **FIT,                     /* matrix for fits */
         *Nvec, *Nlogvec,           /* vectors for developmental profiles */
         *Vvec, 
         *Zvec, *Zlogvec,
         *V1vec, 
         *V2vec; 

FILE     *fpspectrum,               /* fpspectrum: datafile: m, Vm */
         *fpprofile,                /* observed profile */
         *fpexpspect,               /* expected spectrum */
         *fpexpspect2N,             /* spectrum at 2N */
         *fpVN,                     /* file with E[V(N)] and E[V(2N)] */
         *fpsum,                    /* file with summary of model */
         *fpint,                    /* interpolation results */
         *fpext,                    /* extrapolation results */
         *fullspc,		    /* full spectrum .fsp for m=1..skip */
         *fpE,                      /* spectrum at sample size E */
         *fpfit,                    /* data on fits of Z as function of N */
         *fpfitstats;               /* stats for fits of Z as function of N */

int      nranks,                    /* number of different ranks in spectrum */
         maxrank,                   /* largest rank for fit, default 15 */
         i, j,                      /* counter */
         header,                    /* boolean for presence of header */
         k,                         /* variable for chunks */
         nchunks,                   /* number of chunks for interpolation */
         enchunks,                  /* number of chunks for extrapolation */
         token, type,               /* auxiliary variables for scanf */
         skip,			    /* print spectrum only, for m=1..skip */
         optimalfit,                /* number of optimal fit */
         quick,                     /* skip intensive calculations */
         ownparams,                 /* boolean for specifying own parameters */
         aantal;                    /* for command line options */

char     woord[MAXWORDLENGTH],       /* variable for skipping header in fscanf */
         new_name[MAXWORDLENGTH],    /* variables for extension handling    */
         base_name[MAXWORDLENGTH],
         optfit[MAXWORDLENGTH],      /* name of optimal fit  */
         *fs;                        /* variable for scanning options */


/*MAIN () */

int main (argc, argv)
int     argc;
char    *argv[];

{ 
   /* DEFAULTS */

   maxrank = DEF_MAXRANK;
   nchunks = DEF_CHUNKS;
   enchunks = DEF_CHUNKS;
   header = 1;
   E = NULL_F;
   correctie = NULL_F;
   corr2 = NULL_F;
   quick = 0;
   ownparams = 0;

   /* COMMAND LINE OPTIONS */

   while ((--argc > 0) && ((*++argv)[0] == '-')) {
        for (fs = argv[0] + 1; *fs != '\0'; fs++) {
            switch (*fs) {
            case 'h':
                help();
                break;
            case 'k':
                nchunks = leesgetal (fs, &aantal);
                for (; aantal > 0; aantal--){
                   fs++;
                }
                break;
            case 'K':
                enchunks = leesgetal (fs, &aantal);
                for (; aantal > 0; aantal--){
                   fs++;
                }
                break;
            case 'E':
                i =  leesgetal (fs, &aantal);
                E = (double) i;
                for (; aantal > 0; aantal--){
                   fs++;
                }
                break;
            case 'm':
                maxrank = leesgetal (fs, &aantal);
                for (; aantal > 0; aantal--){
                   fs++;
                }
                break;
            case 'g':
                corr2 = leesdouble (fs, &aantal);
                for (; aantal > 0; aantal--){
                   fs++;
                }
                break;
            case 'f':
                correctie = leesdouble (fs, &aantal);
                for (; aantal > 0; aantal--){
                   fs++;
                }
                break;
            case 's':      /* don't interpolate or extrapolate */
                           /* show m and Vm and EVm for m=1..s */
                skip = leesgetal (fs, &aantal);
                for (; aantal > 0; aantal--){
                   fs++;
                }
                if (skip == 0) {
                  fprintf(stderr, "adjZipf: cannot skip with zero rank\n");
                  exit(1);
                }
                break;
            case 'H':      /* input files without headers! */
                header = 0;
                break;
            case 'Q':      /* input files without headers! */
                quick = 1;
                break;
            case 'o':      /* prompt user for fit and parameters */
                ownparams = 1;
                break;
            default:
                fprintf(stderr, "adjZipf: illegal option %c\n", *fs);
                exit(1);
                break;
            }
        }
   } /* of while */


   /* FILE HANDLING */

   if (argc == 0) {
     help ();
   }

   /* load input spectrum, should have .spc extension */

   if ((fpspectrum = fopen(*argv, "r")) == NULL) {
       fprintf(stderr, "adjZipf: can't open spectrum file %s\n", *argv);
       exit(1);
   }

   strncpy(base_name, *argv, strlen(*argv) - 4);  /* argv is nu text.obs */
   change_extension (base_name, new_name, ".obs");

   if ((fpprofile = fopen(new_name, "r")) == NULL) {
       fprintf(stderr, "adjZipf: can't open profile file %s\n", new_name);
       exit(1);
   }

   /* file name handling output files */

 if (skip == 0) {
   change_extension (base_name, new_name, "_aZ.spc");
   if ((fpexpspect = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aZ.sp2");
   if ((fpexpspect2N = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aZ.ev2");
   if ((fpVN = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aZ.sum");
   if ((fpsum = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aZ.int");
   if ((fpint = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aZ.ext");
   if ((fpext = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
      exit(1);
   }
   if (E > NULL_F){
     change_extension (base_name, new_name, "_aZ.sp3");
     if ((fpE = fopen(new_name, "w")) == NULL){
        fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
        exit(1);
     }
   }
   change_extension (base_name, new_name, "_aZ.fit");
   if ((fpfit = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aZ.sta");
   if ((fpfitstats = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
      exit(1);
   }
 } else {
      change_extension (base_name, new_name, "_Z.fsp");
      if ((fullspc = fopen(new_name, "w")) == NULL){
           fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
           exit(1);
      }
      change_extension (base_name, new_name, "_Z.sum");
      if ((fpsum = fopen(new_name, "w")) == NULL){
           fprintf(stderr, "adjZipf: can't open output file %s\n", new_name);
           exit(1);
      }
 }

   /* LOAD SPECTRUM FILE */

   nranks = 0; n1 = 0; n2 = 0;
   if (header){
      fscanf(fpspectrum, "%s ", woord);  /* m */
      fscanf(fpspectrum, "%s ", woord);  /* Vm */
   }

   while (fscanf(fpspectrum, "%d %d", &token, &type) != EOF)  {
        nranks++;
        SPECTRUM[nranks][0] = (double) token;
        SPECTRUM[nranks][1] = (double) type;
        if (token == 1) n1 = type;
        if (token == 2) n2 = type;
        N+= (double) token * (double) type;
        V+= (double) type;
   }
   mmax = SPECTRUM[nranks][0];
   pstar = mmax/N;
   Nzero = N; Vzero = V;

   /* LOAD THE PROFILE STATISTICS ON V V1 Z */

   /* first skip and check the header */

   if (header){
       for (i = 1; i <= NMEASURES+1; i++){
          if (fscanf(fpprofile, "%s ", woord) == EOF){
            fprintf(stderr, "incomplete header for %s.obs\n", base_name);
          }
       }
   }

   /* allocate the required vectors and matrices */

   FIT = matrix (1,nchunks, 1, MAXFITS);
   Nvec = vector (1,nchunks);
   Nlogvec = vector (1,nchunks);
   Zvec = vector (1,nchunks);
   Zlogvec = vector (1,nchunks);
   Vvec = vector (1,nchunks);
   V1vec = vector (1,nchunks);
   V2vec = vector (1,nchunks);
   t = vector (1,MAXFITS);
   r = vector (1,MAXFITS);
   a = vector (1,MAXFITS);
   b = vector (1,MAXFITS);

   /* load the table with observed developmental profiles */

   for (i = 1; i <= nchunks; i++){
       if (fscanf(fpprofile, "%d ", &type) != EOF){
           Nvec[i] = (double) type; 
           Nlogvec[i] = log(Nvec[i]);
       }
       else{
           fprintf(stderr, "%s.obs is incompatible with required number of chunks\n", base_name);
           exit(1);
       }
       for (j = 2; j <= NMEASURES+1; j++){
           if (fscanf(fpprofile, "%lf ", &x) != EOF){
               switch (j){
                 case 4: 
                   Vvec[i] = x; 
                   break;
                 case 5: 
                   V1vec[i] = x; 
                   break;
                 case 6: 
                   V2vec[i] = x; 
                   break;
                 case 21: 
                   Zvec[i] = x; 
                   Zlogvec[i] = log(Zvec[i]);
                   break;
                 default: 
                   break;
              }
           }
           else{
               fprintf(stderr, "%s.obs is incompatible with required number of chunks\n", base_name);
               exit(1);
           }
       }
   }
   
   /* carry out least squares fit for four models */

   linearfit(Nvec, Zvec, nchunks, 1);        /* standard linear fit */
   linearfit(Nlogvec, Zvec, nchunks, 2);     /* logarithmic model   */
   linearfit(Nvec, Zlogvec, nchunks, 3);     /* exponential model   */
   linearfit(Nlogvec, Zlogvec, nchunks, 4);  /* power model         */

   /* and choose the optimal fit, i.e., fit with highest r */

   optimalfit = 0;
   rmax = NULL_F;

   for (i = 1; i <= MAXFITS; i++){
       if (r[i] > rmax) {
           optimalfit = i;
           rmax = r[i];
       }
   }

   switch (optimalfit){
       case 1: fprintf(stdout, "standard linear fit is optimal, r = %7.4f\n", 
               r[optimalfit]);
               strcpy(optfit, "linear");
               break;
       case 2: fprintf(stdout, "logarithmic fit is optimal, r = %7.4f\n", 
               r[optimalfit]);
               strcpy(optfit, "logarithmic");
               break;
       case 3: fprintf(stdout, "exponential fit is optimal, r = %7.4f\n", 
               r[optimalfit]);
               strcpy(optfit, "exponential");
               break;
       case 4: fprintf(stdout, "power fit is optimal, r = %7.4f\n", 
               r[optimalfit]);
               strcpy(optfit, "power");
               break;
       default: fprintf(stderr, "illegal (unknown) fit\n");
               break;
   }
   fflush(stdout);

   /* dump statistics */

   fprintf(fpfitstats, "            t        r            a              b Optimal\n");
   fprintf(fpfitstats, "obs  %8.4f %8.4f %12.5f %14.8f %d\n", 
          t[1],r[1], a[1], b[1], r[optimalfit]==r[1]);
   fprintf(fpfitstats, "log  %8.4f %8.4f %12.5f %14.8f %d\n", 
          t[2],r[2], a[2], b[2], r[optimalfit]==r[2]);
   fprintf(fpfitstats, "exp  %8.4f %8.4f %12.5f %14.8f %d\n", 
          t[3],r[3], exp(a[3]), b[3], r[optimalfit]==r[3]);
   fprintf(fpfitstats, "pow  %8.4f %8.4f %12.5f %14.8f %d\n", 
          t[4],r[4], exp(a[4]), b[4], r[optimalfit]==r[4]);

   fprintf(fpfit, "N Zobs Zlin Zlog Zexp Zpow\n");
   for ( i = 1; i <= nchunks; i++){
     fprintf(fpfit, "%f %f ", Nvec[i], Zvec[i]);
     for (j = 1; j <= MAXFITS; j++){
         fprintf(fpfit, "%f ", FIT[i][j]);
     }
     fprintf(fpfit, "\n");
   }
   fclose(fpfit);

   if (ownparams){
     fprintf(fpfitstats, "user-overruled model choice and parameters:\n");
     fprintf(stderr, "specify model (1:lin; 2:log; 3:exp; 4:pow) 1/2/3/4 ");
     scanf("%d", &optimalfit);
     fprintf(fpfitstats, "model choice: %d (1:lin; 2:log; 3:exp; 4:pow)\n",
            optimalfit);
     fprintf(stderr, "specify intercept and slope ");
     scanf("%lf %lf", &x, &y);
     a[optimalfit] = x;
     b[optimalfit] = y;
     fprintf(fpfitstats, "intercept: %f     slope: %f\n", x, y);
   }
   fclose(fpfitstats);

   /* RE-DETERMINE THE PARAMETER OF THE MODEL */

   Z = zipflink(Nzero, optimalfit);
   VZ = Z/log(pstar*Z);

   /* AND CALCULATE E[V(N)] AND E[V(m,N)] ;  NOTE: S IS INFINITE */

   fprintf(stdout, "computing expected spectrum at N\n");
   fflush(stdout);
   eV = expV(Nzero);
   S = NULL_F;
   if (skip == 0) {
      for (i = 1; i <= maxrank; i++) {
        fprintf(stdout, "[%d]\n", i);
        fflush(stdout);
        SPECTRUM[i][2] = expVm((double) i, Nzero);
        if (quick) break;
      }
   } else {
      for (i = 1; i <= skip; i++) {
        fprintf(stdout, "[%d]\n", i);
        fflush(stdout);
        fprintf(fullspc, "%d %10.2f\n", i, expVm((double) i, Nzero));
      }
   }
   fprintf(stdout, "\n");
   fflush(stdout);

   /* PRINT SUMMARY */

   fprintf(fpsum, "Parameter-adjusted Extended Zipf's Law for %s\n", *argv);
   fprintf(fpsum, "Optimal fit with %s model\n", optfit);
   if (optimalfit <= 2){
       fprintf(fpsum, "Intercept = %12.4f (f = %10.5f)\n", 
             a[optimalfit]+correctie, correctie);
   }
   else{
       fprintf(fpsum, "Intercept = %12.4f (f = %10.5f)\n", 
             exp(a[optimalfit]+correctie), correctie);
   }
   fprintf(fpsum, "Slope     = %12.4f (g = %10.5f)\n", 
                  b[optimalfit]+corr2, corr2);
   fprintf(fpsum, "N         = %12d\n", (int) N);
   fprintf(fpsum, "V(N)      = %12d\n", (int) V);
   fprintf(fpsum, "E[V(N)]   = %12.4f\n", eV);
   fprintf(fpsum, "V(1,N)    = %12d\n", (int) n1);
   fprintf(fpsum, "E[V(1,N)] = %12.4f\n", SPECTRUM[1][2]);
   fprintf(fpsum, "S         = infinite\n");
   fprintf(fpsum, "Z         = %12.5f\n",  Z);
   fprintf(fpsum, "beta      = 1.0\n");
   fprintf(fpsum, "VZ        = %12.5f\n",  VZ);
   fclose(fpsum);

   if (skip > 0) {
      exit(1);
   }

   /* PRINT SPECTRUM */

   fprintf(fpexpspect, "         m         Vm        EVm     alphaM    EalphaM\n");
   for (i = 1; i <= maxrank; i++) {
    fprintf(fpexpspect, "%10d %10d ",(int) SPECTRUM[i][0],(int) SPECTRUM[i][1]);
    fprintf(fpexpspect, "%10.4f %10.4f %10.4f\n", SPECTRUM[i][2],
           SPECTRUM[i][1]/Vzero, SPECTRUM[i][2]/eV);
    if (quick) break;
   }
   fclose(fpexpspect);

   if (quick == 0){

   /* PRINT SPECTRUM AT 2N */

   fprintf(stdout, "computing expected spectrum at 2N\n");

   N = 2 * Nzero;

   /* adjust Z and VZ */

   Z = zipflink(N, optimalfit);
   VZ = Z/log(pstar*Z);

   /* and proceed as before */

   eV2N = expV(N);
   fprintf(fpexpspect2N, "         m      EVm2N\n");
   for (i = 1; i <= 2 * maxrank; i++){
     fprintf(stdout, "[%d]\n", i);
     fflush(stdout);
     fprintf(fpexpspect2N, "%10d %10.2f\n", i, expVm((double) i, N));
   }
   fprintf(stdout, "\n");
   fflush(stdout);
   fclose(fpexpspect2N);

   /* PRINT VOCABULARY SIZES */

   fprintf(fpVN, "       V       EV     EV2N\n");
   fprintf(fpVN, "%8.2f %8.2f %8.2f\n", V, eV, eV2N);
   fclose(fpVN);
   }

   /* INTERPOLATION */

   if (nchunks > 0){

     /* CALCULATE THE TEXT CHUNKS */

     chunksize = floor(Nzero/(nchunks*1.0));
     remainDer = Nzero - ((nchunks*1.0) * chunksize);
     for (k = 1; k <= nchunks; k++)   CHUNKS[k] = chunksize;
     for (k = 1; k <= remainDer; k++) CHUNKS[k]++;
     for (k = 2; k <= nchunks; k++)   CHUNKS[k] += CHUNKS[k-1];

     /* AND PRINT THE CORRESPONDING STATISTICS */

     fprintf(stdout, "computing interpolation statistics\n");
     fprintf(fpint, "       N       EV   Alpha1      EV1      EV2      EV3      EV4      EV5       GV\n");
     for (k = 1; k <= nchunks; k++){

        fprintf(stdout, "[%d]\n", k);
        fflush(stdout);
        /* first get E[V(N+1)] */
        Z = zipflink(CHUNKS[k]+1.0, optimalfit);
        VZ = Z/log(pstar*Z);
        x1 = expV(CHUNKS[k]+1.0);

        /* adjust Z and VZ for each chunksize */
 
        Z = zipflink(CHUNKS[k], optimalfit);
        VZ = Z/log(pstar*Z);

        /* and then proceed as before */

        x = expV(CHUNKS[k]);
        y = expVm(1.0, CHUNKS[k]);
        if (quick == 0){
            y2 = expVm(2.0, CHUNKS[k]);
            y3 = expVm(3.0, CHUNKS[k]);
            y4 = expVm(4.0, CHUNKS[k]);
            y5 = expVm(5.0, CHUNKS[k]);
        }
        fprintf(fpint, "%8.2f %8.2f %8.4f %8.2f %8.2f %8.2f %8.2f %8.2f %8.4f\n", CHUNKS[k], x, y/x, y, y2, y3, y4, y5, x1-x);
     }
     fprintf(stdout, "\n");
     fflush(stdout);

   }

   if (quick) exit(1);

   /* EXTRAPOLATION */
  
   if (E == NULL_F) {  /* extrapolate to 2N */
     fprintf(stdout, "computing extrapolation statistics to 2N\n");
     fflush(stdout);
     fprintf(fpext, "         N         EV        EV1      EV2      EV3      EV4      EV5\n");

     for (k = 1; k <= nchunks; k++){
        fprintf(stdout, "[%d]\n", k);
        fflush(stdout);

        /* adjust Z and VZ for each chunksize */
 
        Z = zipflink(Nzero+CHUNKS[k], optimalfit);
        VZ = Z/log(pstar*Z);

        x = expV(Nzero+CHUNKS[k]);
        y = expVm(1.0, Nzero+CHUNKS[k]);
        if (quick == 0){
            y2 = expVm(2.0, Nzero+CHUNKS[k]);
            y3 = expVm(3.0, Nzero+CHUNKS[k]);
            y4 = expVm(4.0, Nzero+CHUNKS[k]);
            y5 = expVm(5.0, Nzero+CHUNKS[k]);
        }
        fprintf(fpext, "%10.2f %10.2f %10.4f ", Nzero+CHUNKS[k],  x, y);
        fprintf(fpext, "%8.2f %8.2f %8.2f %8.2f\n", y2, y3, y4, y5);
     }
     fprintf(stdout, "\n");
     fflush(stdout);
   }
   else{

     /* FIND NEW CHUNKSIZES */

     fprintf(stdout, "computing extrapolation statistics to E\n");
     fflush(stdout);
     chunksize = floor((E-Nzero)/(enchunks*1.0));
     remainDer = (E-Nzero) - ((enchunks*1.0) * chunksize);
     for (k = 1; k <= enchunks; k++)   CHUNKS[k] = chunksize;
     for (k = 1; k <= remainDer; k++)  CHUNKS[k]++;
     for (k = 2; k <= enchunks; k++)   CHUNKS[k] += CHUNKS[k-1];

     /* PRINT THE GROWTH CURVE */

     fprintf(stdout, "computing extrapolation statistics to 2N\n");
     fflush(stdout);
     fprintf(fpext, "         N         EV        EV1      EV2      EV3      EV4      EV5\n");

     for (k = 1; k <= enchunks; k++){
        fprintf(stdout, "[%d]\n", k);
        fflush(stdout);

        /* adjust Z and VZ for each chunksize */
 
        Z = zipflink(Nzero+CHUNKS[k], optimalfit);
        VZ = Z/log(pstar*Z);

        x = expV(Nzero+CHUNKS[k]);
        y = expVm(1.0, Nzero+CHUNKS[k]);
        if (quick == 0){
            y2 = expVm(2.0, Nzero+CHUNKS[k]);
            y3 = expVm(3.0, Nzero+CHUNKS[k]);
            y4 = expVm(4.0, Nzero+CHUNKS[k]);
            y5 = expVm(5.0, Nzero+CHUNKS[k]);
        }
        fprintf(fpext, "%10.2f %10.2f %10.4f ", Nzero+CHUNKS[k],  x, y);
        fprintf(fpext, "%8.2f %8.2f %8.2f %8.2f\n", y2, y3, y4, y5);
     }
     fprintf(stdout, "\n");
     fflush(stdout);


     /* AND SHOW THE SPECTRUM AT E */

     eV2N = expV(E);
     fprintf(fpE, "         m      EVmXN\n");
     for (i = 1; i <= maxrank; i++){
       fprintf(stdout, "[%d]\n", k);
       fflush(stdout);
       fprintf(fpE, "%10d %10.2f\n", i, expVm((double) i, E));
     }
     fprintf(stdout, "\n");
     fflush(stdout);
   }

   free_vector (Nvec, 1, nchunks);
   free_vector (Nlogvec, 1, nchunks);
   free_vector (Zvec, 1, nchunks);
   free_vector (Zlogvec, 1, nchunks);
   free_vector (Vvec, 1, nchunks);
   free_vector (V1vec, 1, nchunks);
   free_vector (V2vec, 1, nchunks);
   free_matrix (FIT, 1, nchunks, 1, MAXFITS);
   free_vector (t, 1, MAXFITS);
   free_vector (r, 1, MAXFITS);
   free_vector (a, 1, MAXFITS);
   free_vector (b, 1, MAXFITS);

   return (0);
} /* end of main */


double expV (n)
double n;
{
  N = n;
  return( (Z*N*log(N/Z))/( (N-Z) * log(pstar * Z)) );
}


double expVm (m, n)
double m, n;  
{
  mrank = m;
  N = n;
  return( qromb(funcVm, L_BOUND, U_BOUND) * VZ * N / Z ); 
}


double funcVm (x)
double x;
{
 return (x / ( exp( (mrank+1.0) * log(1.0+x) )  *  (1.0 +  (x*N/Z) )));
}


void help ()
{
  fprintf (stderr, "adjZipf text.spc\n");
  fprintf (stderr, "OPTIONS:\n");
  fprintf (stderr, "     -h: display help\n");
  fprintf (stderr, "     -m: number of ranks in fit (default: 15)\n");
  fprintf (stderr, "     -k: number of chunks for interpolation (default: 20)\n");
  fprintf (stderr, "     -K: number of chunks for extrapolation (default: 20)\n");
  fprintf (stderr, "     -E: extrapolation sample size (default: 2N)\n");
  fprintf (stderr, "     -H: input files lack header (default: with header)\n");
  fprintf (stderr, "     -o: specify own model and parameters for Z(N)\n");
  fprintf (stderr, "INPUT:\n");
  fprintf (stderr, "     text.spc\n");
  fprintf (stderr, "     The following file should also be available:\n");
  fprintf (stderr, "     text.obs:  the developmental profiles\n");
  fprintf (stderr, "OUTPUT:\n");
  fprintf (stderr, "     text_aZ.espect:   expected spectrum\n");
  fprintf (stderr, "     text_aZ.espect2:  expected spectrum at 2N\n");
  fprintf (stderr, "     text_aZ.ev2:      E[V(N)] and E[V(2N)]\n");
  fprintf (stderr, "     text_aZ.sum:      summary, fitted parameters\n");
  fprintf (stderr, "     text_aZ.fit:      N Zobs Zlin Zlog Zexp Zpow\n");
  fprintf (stderr, "     text_aZ.sta:      stats for the developmental fits\n");
  exit (1);
}


void linearfit (X, Y, n_obs, fit)
double	*X, *Y;
int	n_obs, fit;

{
  double	sum_x, sum_y, sum_xy, sum_x2, sum_y2;
  int		i;

  sum_x = NULL_F;
  sum_y = NULL_F;
  sum_xy = NULL_F;
  sum_x2 = NULL_F;
  sum_y2 = NULL_F;

  for (i = 1; i <= n_obs; i++) {
    sum_x += X[i];
    sum_y += Y[i];
    sum_xy += X[i] * Y[i];
    sum_x2 += (X[i] * X[i]);
    sum_y2 += (Y[i] * Y[i]);
  }

  b[fit] = ((n_obs * sum_xy) - (sum_x * sum_y)) / 
           ((n_obs * sum_x2) - (sum_x * sum_x));
  a[fit] = (sum_y - b[fit] * sum_x) / n_obs;

  for (i = 1; i <= n_obs; i++) {
    if (fit <= 2) {
      FIT[i][fit] = a[fit] + b[fit] * X[i];
    }
    else {
      FIT[i][fit] = exp (a[fit] + b[fit] * X[i]);
    }
  }

  r[fit] = (n_obs * sum_xy - (sum_x * sum_y)) /
           sqrt (((n_obs * sum_x2) - (sum_x * sum_x)) *
                 ((n_obs * sum_y2) - (sum_y * sum_y)));

  t[fit] = r[fit] * sqrt ((n_obs - 2.0) / (1.0 - r[fit] * r[fit]));
}


double zipflink (NN, ffit)
double	NN;
int	ffit;

{
  switch (ffit) {
    case 1: /* linear fit */
      return (a[ffit] + correctie + ((corr2 + b[ffit]) * NN)); 
      break;
    case 2: /* logarithmic fit */
      return (a[ffit] + correctie + ((corr2 + b[ffit]) * log(NN)));
      break;
    case 3: /* exponential fit */
      return (exp (a[ffit] + correctie + ((corr2 + b[ffit]) * NN))); 
      break;
    case 4: /* power fit */
      return (exp (a[ffit] + correctie + ((corr2 + b[ffit]) * log (NN))));
      break;
    default:
      fprintf (stderr, "adjZipf: illegal fit\n");
      exit (1);
      break;
  }
}
