/*
 *	File: adjSich.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 <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 void	linearfit ();
extern double	sichellink ();
extern double	adjustb ();

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, V1,              /* number of tokens, types, hapaxes, disleg */
         E,                             /* extrapolation sample size */
         SPECTRUM[MAXM1][2],            /* frequency spectrum m Vm */
         alpha, Gamma, theta, b, c, Z,  /* parameters of the model */
         ARS[MAXM1],                    /* array for relative spectrum V(m,N)/V(N) */
         ARS2N[MAXM1],                  /* array for relative spectrum at 2N */
         Nzero,                         /* 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,      /* temp variable */
         rmax,                          /* optimal correlation coefficient */
         correctie,                     /* correction factor on intercept */
         corr2,
         *t,                            /* t statistic */
         *r,                            /* correlation coefficient */
         *aa,                           /* coefficients of linear model */
         *bb,
         **FIT,                         /* matrix for fits */
         *Nvec, *Nlogvec,               /* vectors for developmental profiles */
         *Vvec,
         *Zvec, *Zlogvec,
         *V1vec,
         *V2vec;


FILE     *fpspectrum,                   /* fpspectrum: datafile: m, Vm */
         *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 */
         *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 */
         *fpprofile;                    /* for reading text.obs */

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 */
         optimalfit,                    /* number of optimal fit */
         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;

   /* COMMAND LINE OPTIONS */

   while ((--argc > 0) && ((*++argv)[0] == '-')) {
        for (fs = argv[0] + 1; *fs != '\0'; fs++) {
            switch (*fs) {
            case 'h':
                help();
                break;
            case 'E':
                i =  leesgetal (fs, &aantal);
                E = (double) i;
                for (; aantal > 0; aantal--){
                   fs++;
                }
                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 '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 'H':      /* input files without headers! */
                header = 0;
                break;
            default:
                fprintf (stderr, "adjSich: 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, "adjSich: can't open spectrum file %s\n", *argv);
       exit(1);
   }

   strncpy(base_name, *argv, strlen(*argv) - 4);

   change_extension (base_name, new_name, ".obs");

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

   /* file name handling output files */

   change_extension (base_name, new_name, "_aS.spc");
   if ((fpexpspect = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjSich: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aS.sp2");
   if ((fpexpspect2N = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjSich: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aS.ev2");
   if ((fpVN = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjSich: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aS.sum");
   if ((fpsum = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjSich: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aS.int");
   if ((fpint = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjSich: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aS.ext");
   if ((fpext = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjSich: can't open output file %s\n", new_name);
      exit(1);
   }
   if (E > NULL_F){
     change_extension (base_name, new_name, "_aS.sp3");
     if ((fpE = fopen(new_name, "w")) == NULL){
        fprintf(stderr, "adjSich: can't open output file %s\n", new_name);
        exit(1);
     }
   }

   change_extension (base_name, new_name, "_aS.fit");
   if ((fpfit = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjSich: can't open output file %s\n", new_name);
      exit(1);
   }
   change_extension (base_name, new_name, "_aS.sta");
   if ((fpfitstats = fopen(new_name, "w")) == NULL){
      fprintf(stderr, "adjSich: 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;
   }
   Nzero = N;
   V1 = n1;

   /* 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);
   aa = vector (1, MAXFITS);
   bb = 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 19:   /* this is the parameter c */
                   if (x > NULL_F){
                       Zvec[i] = x;
                       Zlogvec[i] = log(Zvec[i]);
                   }
                   else{
                       Zvec[i] = ADJSICHCONST;
                       Zlogvec[i] = ADJSICHCONST;
                   }
                   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 (fabs(r[i]) > rmax) {
           optimalfit = i;
           rmax = fabs(r[i]);
       }
   }

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

   /* 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], aa[1], bb[1], r[optimalfit]==r[1]);
   fprintf(fpfitstats, "log  %8.4f %8.4f %12.5f %14.8f %d\n",
          t[2],r[2], aa[2], bb[2], r[optimalfit]==r[2]);
   fprintf(fpfitstats, "exp  %8.4f %8.4f %12.5f %14.8f %d\n",
          t[3],r[3], exp(aa[3]), bb[3], r[optimalfit]==r[3]);
   fprintf(fpfitstats, "pow  %8.4f %8.4f %12.5f %14.8f %d\n",
          t[4],r[4], exp(aa[4]), bb[4], r[optimalfit]==r[4]);
   fclose(fpfitstats);

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

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

   c = sichellink(Nzero, optimalfit);
   b = adjustb(Nzero, V1, c);
   Z = 1.0/c;
    
   /* CONSTRUCT RELATIVE FREQUENCY SPECTRUM FOR THE FIRST maxrank RANKS */
 
   ARS[1] = alpha1 ();
   ARS[2] = alpha2 (ARS[1]);
   for (i = 3; i <= maxrank; i++){
      ARS[i] = alphaRecur( (double) i, ARS[i-1], ARS[i-2]);
   }

   /* AND CALCULATE E[V(N)] and S */

   eV = expV ();
   S = 2 * Z / b;
   Nzero = N;    /* take present sample size as Nzero */

   /* PRINT SUMMARY */

   fprintf(fpsum, "Parameter-adjusted Inverse Gauss-Poisson model 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", 
               aa[optimalfit]+correctie, correctie);
   }
   else{
       fprintf(fpsum, "Intercept = %12.4f (f = %10.5f)\n", 
               exp(aa[optimalfit]+correctie), correctie);
   }
   fprintf(fpsum, "Slope     = %12.4f (g = %10.5f)\n", 
               bb[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", eV*ARS[1]);
   fprintf(fpsum, "S         = %12.4f\n\n", S);
   fprintf(fpsum, "b         = %12.10f\n",  b);
   fprintf(fpsum, "c         = %12.10f\n",  c);
   fprintf(fpsum, "Z         = %12.5f\n",  Z);
   fprintf(fpsum, "gamma     = %12.8f\n",  -0.5);
   fclose(fpsum);

   /* 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", 
           ARS[i]*eV,  SPECTRUM[i][1]/V, ARS[i]);
   }
   fclose(fpexpspect);

   /* PRINT SPECTRUM AT 2N */

   N = 2.0 * Nzero;

   c = sichellink(N, optimalfit);
   b = adjustb(Nzero, V1, c);
   Z = 1.0/c;

   eV2N = expV ();
   ARS2N[1] = alpha1();
   ARS2N[2] = alpha2(ARS2N[1]);
   for (i = 3; i <= 2*maxrank; i++){
      ARS2N[i] = alphaRecur( (double) i, ARS2N[i-1], ARS2N[i-2]);
   }

   fprintf(fpexpspect2N, "         m      EVm2N\n");
   for (i = 1; i <= 2 * maxrank; i++){
     fprintf(fpexpspect2N, "%10d %10.2f\n", i, ARS2N[i]*eV2N);
   }
   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(fpint, "       N       EV   Alpha1      EV1      EV2     EV3      EV4      EV5       GV\n");
     for (k = 1; k <= nchunks; k++){
        /* for discrete growth rate, first get E[V(N+1)[ */
        N = CHUNKS[k]+1;
        c = sichellink(N, optimalfit);
        b = adjustb(Nzero, V1, c);
        Z = 1.0/c;
        x1 = expV ();
        /* next compute stats for N itself */
        N = CHUNKS[k];
        c = sichellink(N, optimalfit);
        b = adjustb(Nzero, V1, c);
        Z = 1.0/c;
        x = expV ();
        y = alpha1 ();
        fprintf(fpint, "%8.2f %8.2f %8.4f %8.2f", N,  x, y, x*y);
        y2 = alpha2(y);
        y3 = alphaRecur((double) 3, y2, y);
        y4 = alphaRecur((double) 4, y3, y2);
        y5 = alphaRecur((double) 5, y4, y3);
        fprintf(fpint, "%8.2f %8.2f %8.2f %8.2f %8.4f\n", 
                        y2*x, y3*x, y4*x, y5*x, x1-x);
     }
     fclose(fpint);
   }

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

     for (k = 1; k <= nchunks; k++){
        N = Nzero + CHUNKS[k];
        c = sichellink(N, optimalfit);
        b = adjustb(Nzero, V1, c);
        Z = 1.0/c;
        x = expV ();
        y = alpha1();
        fprintf(fpext, "%10.2f %10.2f %10.4f ", N,  x, y*x);
        y2 = alpha2(y);
        y3 = alphaRecur((double) 3, y2, y);
        y4 = alphaRecur((double) 4, y3, y2);
        y5 = alphaRecur((double) 5, y4, y3);
        fprintf(fpext, "%8.2f %8.2f %8.2f %8.2f\n",(y2*x),(y3*x),(y4*x),(y5*x));
     }
   }
   else{ 
     
     /* FIND NEW CHUNKSIZES */

     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(fpext, "         N         EV        EV1      EV2      EV3      EV4      EV5\n");

     for (k = 1; k <= enchunks; k++){
        N = Nzero + CHUNKS[k];
        c = sichellink(N, optimalfit);
        b = adjustb(Nzero, V1, c);
        Z = 1.0/c;
        x = expV ();
        y = alpha1();
        fprintf(fpext, "%10.2f %10.2f %10.4f ", N,  x, y*x);
        y2 = alpha2(y);
        y3 = alphaRecur((double) 3, y2, y);
        y4 = alphaRecur((double) 4, y3, y2);
        y5 = alphaRecur((double) 5, y4, y3);
        fprintf(fpext, "%8.2f %8.2f %8.2f %8.2f\n",(y2*x),(y3*x),(y4*x),(y5*x));
     }


     /* AND SHOW THE SPECTRUM AT E */

     N = E;
     c = sichellink(N, optimalfit);
     b = adjustb(Nzero, V1, c);
     Z = 1.0/c;

     eV2N = expV ();
     ARS2N[1] = alpha1();
     ARS2N[2] = alpha2(ARS2N[1]);
     for (i = 3; i <= maxrank; i++){
         ARS2N[i] = alphaRecur( (double) i, ARS2N[i-1], ARS2N[i-2]);
     }
     fprintf(fpE, "         m      EVmXN\n");
     for (i = 1; i <= maxrank; i++){
       fprintf(fpE, "%10d %10.2f\n", i, ARS2N[i]*eV2N);
     }
   }

   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 (aa, 1, MAXFITS);
   free_vector (bb, 1, MAXFITS);

   return (0);
}


double expV ()
{
 return(
   ((2*Z)/b) *
      ( 1.0 -
         exp(
           b*(1.0 - sqrt(1.0+ (N/Z)))
         )
      )
 );
}


double alpha1()
{
 return(
   (b*N)/( (2.0*Z)*sqrt(1.0 + (N/Z))) *
     (1.0/
        (
           exp(
             b * (sqrt(1+ (N/Z)) - 1.0)
           )
           - 1.0
        )
     )
 ); 
}


double alpha2(a1)   
double a1;
{
 return(
   (a1 / ( 4.0 * ((Z/N) + 1.0)) ) *
   ( (b* sqrt(1.0+(N/Z))) + 1.0)
 );
}


double alphaRecur(m, amin1, amin2)
double m, amin1, amin2;
{
  double x;
  x = (b*N)/(2*Z*sqrt(1+(N/Z)));
  return(
    (((m-1.0-0.5)/m)*(1.0/( (Z/N)+1.0)) * amin1) +
    ((x * x)/(m*(m-1.0))*amin2)
  );
}


void help ()
{
  fprintf (stderr,"adjSich 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,"INPUT:\n");
  fprintf (stderr,"     text.spc:  m Vm\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_aS.spc:  expected spectrum\n");
  fprintf (stderr,"     text_aS.sp2:  expected spectrum at 2N\n");
  fprintf (stderr,"     text_aS.ev2:  E[V(N)] and E[V(2N)]\n");
  fprintf (stderr,"     text_aS.int:  interpolation statistics\n");
  fprintf (stderr,"     text_aS.ext:  extrapolation statistics\n");
  fprintf (stderr,"     text_aS.sum:  summary, fitted parameters\n");
  fprintf (stderr,"     text_aS.fit:  N Zobs Zlin Zlog Zexp Zpow\n");
  fprintf (stderr,"     text_aS.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, adjn_obs;
 
  adjn_obs = n_obs;

  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++) {
    if (Y[i] != ADJSICHCONST) {
      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]);
    }
    else {
      adjn_obs--;
    }
  }

  bb[fit] = ((adjn_obs * sum_xy) - (sum_x * sum_y)) / 
            ((adjn_obs * sum_x2) - (sum_x * sum_x));
  aa[fit] = (sum_y - bb[fit] * sum_x) / adjn_obs;

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

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

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


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

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


double adjustb (NN, VV1, C)
double	NN, VV1, C;

{
  double	g;

  g = 1.0 / sqrt (1.0 + NN * C);
  return ((log (g * NN / VV1) / (1.0 - g)) / sqrt (1.0 + NN * C));
}
