/*-----------------------------------------------------------------------------
Copyright 1997-2000: Fred Hutchinson Cancer Research Center, Seattle, WA  USA
 find_biassed_blocks.c - identify blocks with biassed composition

Revised criteria June 2000:
1. Compute correlation coeff for each pair of columns
2. Clump columns based on 1. with correlation coeffs >= col_score_cutoff
3. Biassed if max clump from 2. has >= bias_cutoff percent of cols in block
   and has >= min_cols

 A biassed block is one with a significant number of conserved columns similar 
to one another. The degree of similarity and fraction of similar columns are
program parameters. The r correlation coefficient is used to compare the 
columns. A potential problem with the use of this column comparison measure is 
that non conserved columns with similar distribution of aa will get high scores.
Biological examples of such columns are hydrophobic positions. Blocks of 
transmembrane regions have such columns.

July 96, spruced up this version (2) for use in WWW page. Only output format
 affected. 

      Aug 20, 96' - blimps 3.1 defines matrix->weights as double (was int)
                    matrix->weights values are rounded before printing.

                    changed width of printed matrix lines to depend on www 
                    flag - if flag is on up to 55 positions are printed per 
                    line, else 18.
  11/25/98 Simplify output. Look for amino.frq in $BLIMPS_DIR
   5/24/00 Apply fraction of similar columns to # of columns, not to
		# of pairs of columns
   6/ 1/00 Clump columns based on correlation score & apply fraction to
	   clump size; require a minimum of MIN_COLS
   9/27/00 Make MIN_COLS a parameter
-----------------------------------------------------------------------------*/

#define EXTERN

#define SEARCH_TYPE_UNSET  -1

#define COL_SCORE_CUTOFF 0.25
#define BIAS_CUTOFF 0.50
#define MIN_COLS 3
#define MAXROWS 100
#define INDEX(n, col, row) (col*n - (col*(col+3))/2 - 1 + row)

#include "blocksprogs.h"
#include "blkvblk.h"

/* variables set by the configuration file in blimps program */

int StrandsToSearch;
int NumberToReport;
int SearchType;
int GeneticCodeInitializer;
int SiteSpecificScoringMatrixType;
int BlockToMatrixConversionMethod; /* default method is two */
int SequenceMatrixScoringMethod;   /* default method is zero */

/*
 * Local variables and data structures
 */

int    getargs(), data_read() ;

void   set_defaults(), fprint_matrix() ;

double cols_score(), cols_scoreNPrd() ;

char   DBtype() ;

Block  *read_a_prodom_entry() ;
int cluster();

int         alloctd_algnmnts ;
int         alignments_done = 0 ;
int         dbg_lvl = 0 ;
Boolean     WWW_FLAG = TRUE ;

/*=======================================================================*/
/*
 * main
 *   controls flow of program
 *   Parameters: argc, argv
 *   Error codes:
 */

int main(argc, argv)
     int argc;
     char *argv[];
{
  int           i1, i2, similar_pairs, similar_cols, max_clump, flag;
  int           read_entries = 0, hits = 0 , min_cols;
  FILE          *bfp, *out ;
  Block         *block ;
  Matrix        *matrix ;
  char          bdbname[MAXNAME], outname[MAXNAME], ctemp[MAXNAME] ;
  char          line[MAXLINELEN], db_type, percent_char[5] ;
  char		*blimps_dir;
  double        col_score, col_score_cutoff, bias_cutoff, frac_similar_pairs ; 
  double	frac_similar_cols, frac_max_clump ;
  struct pair *pairs;
  int npair, px;


/* set column score cutoff.
   Columns with scores above the cutoff are considered similar */
  col_score_cutoff = COL_SCORE_CUTOFF ;  

/* set bias fraction cutoff.
   Blocks that have more then this fraction of similar scores are considered 
   biassed */
  bias_cutoff = BIAS_CUTOFF ;  
  min_cols = MIN_COLS ;

                /* If no parameters passed on command line show how to do it */
  if (argc == 1) 
     printf("\n%s blocks_db [column score cutoff [bias fraction cutoff [min biased cols [debug level]]]]\n", 
            argv[0]) ;

                                      /* getting input and output file names */
  if ((getargs(argc,argv,bdbname,&bfp,&col_score_cutoff,&bias_cutoff,&min_cols)) != OK) 
     exit(ERROR) ; 

  sprintf(outname,"%s.biassed_blocks", bdbname) ;
  out = NULL;
  if ( ! WWW_FLAG && (out=fopen(outname, "w")) == NULL)
     {
     printf("\nCannot open output file file \"%s\"\n", outname);
     return(ERROR);
     }

                                                    /*set the default values */
  set_defaults();

                                                         /* find out DB type */
  if ((db_type = DBtype(&bfp)) == ERROR) exit(ERROR) ; 

  if (WWW_FLAG) strcpy(percent_char,"&#37") ;
  else          strcpy(percent_char,"%") ;

                             /* print parameters used and scores header line */ 
  if (! WWW_FLAG) printf("%s.\n", argv[0]) ;

  sprintf(line,
"Normalized Sum-of-Products column score\nColumn score cutoff %.3f. Bias-fraction cutoff %2d percent (minimum %d columns).\n", 
         col_score_cutoff, (int) (bias_cutoff*100.), min_cols ) ;

  printf("%s\n",line) ;
  if (! WWW_FLAG) fprintf(out,"%s\n",line) ;


                   /* load the frequencies for converting blocks to matrices */
  blimps_dir = getenv("BLIMPS_DIR");
                   /* load the frequencies for converting blocks to matrices */
  if ( ! load_frequencies(AA_FREQUENCY_FNAME) )
  {
     if (blimps_dir != NULL)
     {
        sprintf(ctemp, "%s/docs/%s", blimps_dir, AA_FREQUENCY_FNAME);
	fprintf(stderr, "Trying %s...\n", ctemp);
        load_frequencies(ctemp) ;
     }
  }


  printf("               Pairs                 Columns         Clumps\n");
  printf("Block    Width Total Biassed Percent Biassed Percent Biassed Percent\n");
                                      /* looping through all the entry pairs */
  while (data_read(&bfp,&block,&matrix,db_type) == OK) 
  {
     read_entries++ ;

     if (dbg_lvl > 4)
        printf("%-10s (%2d columns)\n", matrix->number, matrix->width) ;

     similar_pairs = similar_cols = max_clump = 0 ;
     npair = matrix->width * (matrix->width - 1)/2;
     pairs = (struct pair *) malloc (npair * sizeof(struct pair));
     /* compare all matrix columns with each other. */
     for (i1=0; i1 < matrix->width; i1++)
     {
         flag = 0;
         for (i2=i1+1; i2 < matrix->width; i2++)
 	 {
             /* col_score is correlation coeff between 0.0 and 1.0  */
             col_score = cols_scoreNPrd(matrix->weights,i1,matrix->weights,i2) ;
             px = INDEX(matrix->width, i1, i2);
             pairs[px].score = (int) 100.0 * col_score;
             if (col_score >= col_score_cutoff) 
             { similar_pairs++ ; flag = 1; }

             if (dbg_lvl > 5)
                printf(" %2d %2d  %.3f\n", i1, i2, col_score) ;
             else if 
                (dbg_lvl > 4 && col_score >= col_score_cutoff)
                printf(" %2d %2d  %.3f\n", i1, i2, col_score) ;

	 }
         if (flag) similar_cols++;
     }
     max_clump = cluster(col_score_cutoff, min_cols,  matrix->width, pairs);
     frac_max_clump = (double) max_clump / matrix->width;
     frac_similar_cols = (double) similar_cols/matrix->width;
     frac_similar_pairs = (double) 
                     similar_pairs/(matrix->width * (matrix->width - 1) / 2) ;


          /* check if the fraction of similar scores is above the cutoff to 
                                            be identified as biassed blocks. */
     if (frac_max_clump >= bias_cutoff)
     {
        hits++ ;

        sprintf(line, "%-10s %2d   %4d  %4d   %3d      %4d   %3d      %4d   %3d",
                matrix->number, matrix->width, 
                (matrix->width * (matrix->width - 1) / 2),
		similar_pairs, (int) (frac_similar_pairs*100),
		similar_cols,  (int) (frac_similar_cols*100.),
		max_clump,     (int) (frac_max_clump*100.));

	 
        printf("%s\n",line) ;
        if (! WWW_FLAG) fprintf(out,"%s\n",line) ;

        if (dbg_lvl == 1)
        {
           if (db_type != MATRIX_DB) { output_block(block, stdout); }
           else                      { fprint_matrix(matrix,stdout); }

        }
        if (dbg_lvl == 2)
           if (db_type != MATRIX_DB) fprint_matrix(matrix,stdout) ;
     }
     else if (dbg_lvl > 2)
/*
        printf(
          "Block %-10s (%2d columns) has         %2d%s (%d/%d) similar column pairs.\n",
               matrix->number, matrix->width, 
               (int) (frac_similar_pairs*100.), percent_char, similar_pairs,
               (matrix->width * (matrix->width - 1) / 2)) ;
*/
        printf("%-10s %2d   %4d  %4d   %3d      %4d   %3d      %4d   %3d\n",
                matrix->number, matrix->width, 
                (matrix->width * (matrix->width - 1) / 2),
		similar_pairs, (int) (frac_similar_pairs*100),
		similar_cols,  (int) (frac_similar_cols*100.),
		max_clump,     (int) (frac_max_clump*100.));


     if (db_type != MATRIX_DB) free_block(block) ;
     free_matrix(matrix) ;
     free(pairs);
  }

  if (WWW_FLAG)
     sprintf(line,"%d biassed blocks found in the %d blocks.", 
             hits, read_entries) ;
  else
     sprintf(line,"%d biassed blocks found in the %d blocks from file %s.", 
             hits, read_entries, bdbname) ;

  printf("\n%s\n",line) ;
  if (! WWW_FLAG) fprintf(out,"%s\n",line) ;

  fclose(bfp); if (! WWW_FLAG) fclose(out);         /* close files */

  if (! WWW_FLAG) printf ("Output written in file %s.\n", outname) ;
  exit(0);

}  /* end of main */


/*****************************************************************************
 * get input and output file names and other program parameters interactively
 * or from command line. 
 *****************************************************************************/

int getargs(argc,argv,bdbname,bfp,col_score_cutoff,bias_cutoff,min_cols)

int    argc;
char   *argv[];
char   bdbname[] ;
FILE   **bfp;
double *col_score_cutoff, *bias_cutoff ;
int *min_cols;

{
/* ------------1st arg = block file --------------------------------------*/
   if (argc > 1) strcpy(bdbname, argv[1]);
   else                                   /* get input file interactively */
      {
      printf("\nEnter name of a file with blocks or block matrices: ");
      gets(bdbname);
      }

   if ( (*bfp=fopen(bdbname, "r")) == NULL)
      {
      printf("\nCannot open file \"%s\"\n", bdbname);
      return(ERROR);
      }


/* ------------optional 2nd arg = column score cutoff ------------------*/

   if (argc > 2) *col_score_cutoff = atof(argv[2]) ;

   if (*col_score_cutoff == 0)
      *col_score_cutoff = COL_SCORE_CUTOFF ;
   else if (*col_score_cutoff < -1.0 || *col_score_cutoff > 1.0)
      {
      printf("\nColumn score cutoff has to be between -1 and 1 !\n") ;
      printf("The value given (%f) is out of range.\n", *col_score_cutoff) ;
      return(ERROR) ;
      }

/* ------------optional 3rd arg = bias fraction cutoff ------------------*/

   if (argc > 3) *bias_cutoff = atof(argv[3]) ;

   if (*bias_cutoff == 0)
      *bias_cutoff = BIAS_CUTOFF ;
   else if (*bias_cutoff <= 0 || *bias_cutoff > 1.0)
      {
      printf("\nBias fraction cutoff has to be between 0 and 1 !\n") ;
      printf("The value given (%f) is out of range.\n", *bias_cutoff) ;
      return(ERROR) ;
      }

/* ------------optional 4th arg = bias fraction cutoff ------------------*/

   if (argc > 4) *min_cols = atoi(argv[4]) ;

   if (*min_cols <= 0) *min_cols = MIN_COLS ;

/* ------------optional 5th arg = debug level ------------------*/

   if (argc > 5) dbg_lvl = atoi(argv[5]) ;

   return(OK) ;

}

/****************************************************************************
 * set the default values for some of the variables.
 ****************************************************************************/

void set_defaults()
{

  GeneticCodeInitializer = 0;           /* the standard genetic code */

  StrandsToSearch = 2;          /* == 2 if want to search both strands */
  NumberToReport  = 0;          /* <0 means all, 0 means judge, */
                                /* >0 means use that number */
  SearchType      = SEARCH_TYPE_UNSET;

  BlockToMatrixConversionMethod = 2; /* default method is two */
  SequenceMatrixScoringMethod   = 0; /* default method is zero */

  ErrorLevelReport = WARNING_ERR_LVL; /* report all errors */

}


/*****************************************************************************
 * cols_score
 * compare a pair of matrix columns (positions)
 ****************************************************************************/

double cols_score(mat1,col1,mat2,col2)

MatType *mat1[], *mat2[] ;
int     col1, col2 ;

{
   double score ;
   double p1=0.0, p2=0.0, p3a=0.0, p3b=0.0, p4a=0.0, p4b=0.0 ;
   int    aa ;

                 /* Calculate Pearson's r score between the 2 matrix columns */

   for (aa=0; aa<MATRIX_CMPRD_WIDTH; aa++)
      {
      p1  += mat1[aa][col1] * mat2[aa][col2] ;
      p3a += mat1[aa][col1] * mat1[aa][col1] ;
      p3b += mat1[aa][col1] ; 
      p4a += mat2[aa][col2] * mat2[aa][col2] ;
      p4b += mat2[aa][col2] ;
      }

   p2  = (double) p3b * p4b / MATRIX_CMPRD_WIDTH ;
   p3b = (double) p3b * p3b / MATRIX_CMPRD_WIDTH ;
   p4b = (double) p4b * p4b / MATRIX_CMPRD_WIDTH ;

   if ((p3a != p3b) && (p4a != p4b))
      score = (p1 - p2) / sqrt((p3a-p3b)*(p4a-p4b)) ;
   else    /* avoid dividing by 0 */
      score = 0 ;

   return(score) ;
}


/*****************************************************************************
 * cols_scoreNPrd
 * compare a pair of matrix columns (positions) using the normalized product
 * sum - the dot product normalized to range between 0 and 1 
 ****************************************************************************/

double cols_scoreNPrd(mat1,col1,mat2,col2)

MatType *mat1[], *mat2[] ;
int     col1, col2 ;

{
   double score = 0.0 ;
   int    aa ;


   for (aa=0; aa<MATRIX_CMPRD_WIDTH; aa++)
      if (mat1[aa][col1] > 0 && mat2[aa][col2] > 0)
         score += mat1[aa][col1] * mat2[aa][col2] ;

 /* normalize maximal score to 1.0 */ 
   score /= 10000.0 ;
   
   return(score) ;

}

/****************************************************************************
 * find out if a file (DB) is of blocks, ProDom multiple alignments or matrices
 * The first entry in the file (ending with a "//") will be read.
 * If the entry contains a line begining with "BL   " it will be declared a
 * blocks database, if it will contain a line begining with "MA   " it will be 
 * declared a matrices database. If none or both are found than it will be
 * declared as neither
 ****************************************************************************/

char DBtype(dbfile)

FILE  **dbfile ;

{

   char    *first_entry, *tmp_ptr ;
   char    rc = '\0' ;
   int     entrysize ;
   int     entrylen = 0 ;
   Boolean check = FALSE ;

   entrysize = ENTRYSIZE ;

   first_entry = (char *) malloc(entrysize*sizeof(char)) ;

     /* read first line to determine if file has ProDom multiple alignment
        format - "># (#)", where # is one or more digits */

   if (fgets(first_entry, ENTRYSIZE-1, *dbfile) != NULL && 
       (int) strlen(first_entry) >= 6)
      {
      if (first_entry[0] == '>')              /* check if first char is ">" */
	 {
                                         /* check if second char is a digit */
         if (isdigit(first_entry[1]) != 0)
	    {
                                             /* read all consecutive digits */
            for (entrysize=2; 
                 entrysize<ENTRYSIZE-1 && isdigit(first_entry[entrysize]);
                 entrysize++) ;

                    /* check that the number of digits isn't improbable and 
                       that following the digit(s) is a " ("               */
            if (entrysize != ENTRYSIZE-1        && 
                first_entry[entrysize]   == ' ' && 
                first_entry[++entrysize] == '(')
	       {
                                             /* read all consecutive digits */
               for (entrysize=entrysize+2; 
                    entrysize<ENTRYSIZE-1 && isdigit(first_entry[entrysize]);
                    entrysize++) ;

                    /* check that the number of digits isn't improbable and 
                       that following the digit(s) is a ")"               */
               if (entrysize != ENTRYSIZE-1 && first_entry[entrysize] == ')')
		  {
           /* most probably this is a ProDom multiple alignments database */
                  rewind(*dbfile) ;
                  return(ProDom_mul_DB) ;
		  }
	       }
	    }
         }
      }

   rewind(*dbfile) ;
                                                          /* read until EOF */

   while ((first_entry[entrylen++]=getc(*dbfile)) != EOF)
      {
      if (first_entry[entrylen-1] == '/')
         {
         if (check)                                             /* // found */
            {
            first_entry[entrylen-1] = '\0' ;            /* terminate string */
            rewind (*dbfile) ;

                                /* check if first entry has BL and MA lines */

            if ((strstr(first_entry,"\nBL   ")) != NULL) rc = BLOCK_DB ;

            if ((strstr(first_entry,"\nMA   ")) != NULL) 
            {
               if (rc == BLOCK_DB) 
                  {
                  printf(
                  "First entry in input file has both block and matrix lines !\n") ;
                  return(ERROR) ;
                  }
               else
                  { rc = MATRIX_DB ; }
            }

            if (rc != BLOCK_DB && rc != MATRIX_DB)
               {
               printf(
               "First entry in input file has neither block nor matrix lines !\n") ;
               return(ERROR) ;
               }

            free (first_entry) ;

            return(rc) ;
            }
         else check = TRUE ;                     /* / found check next char */
         }
      else
         check = FALSE ;/* if current char isn't / no need to check next one */


      if (entrylen == entrysize)   /* need more memory for array first_entry */
         {
         entrysize += ENTRYSIZE ;
         tmp_ptr = (char *) realloc(first_entry, entrysize*sizeof(char)) ;
         first_entry = tmp_ptr ;
         }

      }

                                                     /* no // found in file */
      printf("Input file doesn't have any entries !\n") ;

      return(ERROR) ;

}

/****************************************************************************
 * Read entry from appropriate dbfile (block, ProDom or matrix) according to 
 * db_type. If entry is not a matrix read it into a block structure and 
 * transform it into a matrix. If can not read entry return error. 
 ****************************************************************************/

int data_read(dbfile,block,matrix,db_type)

FILE   **dbfile ;
Block  **block ;
Matrix **matrix ;
char   db_type ;

{
   if (db_type == BLOCK_DB)
      {
      if ((*block = read_a_block(*dbfile)) == NULL) return (ERROR) ;
      *matrix = block_to_matrix(*block,BlockToMatrixConversionMethod) ;
      }
   else if (db_type == ProDom_mul_DB)
      {
      if ((*block = read_a_prodom_entry(*dbfile)) == NULL) return (ERROR) ;
      *matrix = block_to_matrix(*block,BlockToMatrixConversionMethod) ;
      }
   else if (db_type == MATRIX_DB)
      {
      if ((*matrix = read_a_matrix(*dbfile)) == NULL) return (ERROR) ;
      }
   else
      {
      printf(
       "Error. variable db_type (%c) is of unknown type !\n",
       db_type) ;
      exit (ERROR) ;
      }

   return (OK) ;

}

Block *read_a_prodom_entry(db)

FILE   *db ;

{
   Block    *block ;
   char     line[MAXLINELEN], word[MAXLINELEN], entry_name[MAXLINELEN] ;
   char     *ptr, *iptr ;
   int      i1, i2, num_seqs, rc, max_pos, min_pos, temp ;
   Sequence *sequence_pointer ;
   Residue  *residue_pointer ;


                 /* read until a prodom entry first line - begins with a ">" */
   while((fgets(line, MAXLINELEN, db)) != NULL && line[0] != '>') ;

   if (line[0] != '>') return(NULL) ;

                                                /* allocate space for block */
     CheckMem(block = (Block *) malloc(sizeof(Block))) ;

/* process first line - the description line */

   line[0] = ' ' ;                                        /* get rid of '>' */
                                          /* get first word - sequence name */
   if ((ptr = get_token(line)) == NULL) 
      {
      printf("Error ! Problem in format of ProDom entry description -line\n") ;
      return(NULL) ;
      }

                            /* create accession prefix - "PD" + preceding 0s,
                                entry presumed not to be longer then 5 chars */
   word[0] = 'P' ;   word[1] = 'D' ; 
   i2 = 2 ;
   for(i1=0; i1<(5 - (int) strlen(ptr)); i1++) word[i2++] = '0' ;
   word[i2] = '\0' ;

   strcpy(entry_name, ptr) ;
                                       /* save first word in block accession */
   sprintf(block->ac, "%s%s;", word, entry_name) ;
   sprintf(block->number, "%s%s", word, entry_name) ;

                                              /* save first word in block ID */
   sprintf(block->id, "%s; ProDom_mul", entry_name) ;

                 /* get second word - number of sequences between parethesis */
   if ((ptr = get_token(NULL)) == NULL) 
      {
      printf("Error ! Problem in format of ProDom entry description-line\n") ;
      return(NULL) ;
      }

                                                        /* strip parenthesis */
   if (ptr[0] != '(')
      {
      printf("Error ! Problem in ProDom entry %s\n", entry_name) ;
      printf("second word in description line doesn't begin with a (\n") ;
      return(NULL) ;
      }
   else
      ptr[0] = '0' ;

   if (ptr[strlen(ptr)-1] != ')')
      {
      printf("Error ! Problem in ProDom entry %s\n", entry_name) ;
      printf("second word in description line doesn't end with a )\n") ;
      return(NULL) ;
      }
   else
      ptr[strlen(ptr)-1] = ' ' ;

               /* check that second word is composed of digits and copy it */
   for(iptr=ptr; *iptr != ' ' && isdigit(*iptr); iptr++) ;
   if (*iptr != ' ')
      {
      printf("Error ! Problem in format of ProDom entry %s\n", entry_name) ;
      printf("A non-digit in the number-of-sequences field \"%s\"\n", ptr) ;
      return(NULL) ;
      }

   block->num_sequences = atoi(ptr) ;

   if (block->num_sequences <= 1) 
      {
      printf(
       "Error ! Number of sequences in ProDom entry %s (%d) is less than 2\n",
       entry_name, block->num_sequences) ;
      return(NULL) ;
      }
   else 
      block->max_sequences = block->num_sequences ;

                                                        /* get rest of line */
   for(iptr=ptr; *iptr != '\0'; iptr++) ;       /* find end of current word */

                            /* get rid of leading and trailing white spaces */
   ptr = eat_whitespace(iptr+1) ;
   remove_trailing_whitespace(ptr) ;

                                   /* save string in block description line */
   strncpy(block->de, ptr, SMALL_BUFF_LENGTH) ;
                           /* in case word is longer than SMALL_BUFF_LENGTH 
                                      and thus the last char copied isnt \0 */ 
   block->de[SMALL_BUFF_LENGTH-1] = '\0' ;

   block->num_clusters = block->max_clusters = 1 ; 
   block->motif[0] = '\0';
   block->percentile = 0 ;
   block->strength = 0 ;

                                         /* allocate space for the clusters */
   CheckMem(block->clusters = (Cluster *) 
                             calloc(block->max_clusters, sizeof(Cluster))) ;

/* process next lines - the sequence lines */
  
          /* read all lines until a line starting with a space, EOL or '>' */
/* Note that if a line begining with '>' was read (the description line of 
   the next entry) it won't be read in fetching the next entry and that 
   entry will be lost */

   
   for(num_seqs=0;
       (fgets(line, MAXLINELEN, db)) != NULL && 
       line[0] != '\n' && line[0] != ' '  && line[0] != '>' ;
       num_seqs++)
      {
                                          /* get first word - sequence name */
      if ((ptr = get_token(line)) == NULL) 
         {
         printf(
            "Error ! Problem in format of ProDom entry %s sequence-line %d\n",
                entry_name, num_seqs+1) ;
         return(NULL) ;
         }

           /* temporarily store sequence name, if this is first sequence 
              the sequences length isn't known and no memory allocated yet, 
              place it in block sequence structure after memory is allocated */
      strcpy(word, ptr) ;

                               /* get second word - sequence start position */
      if ((ptr = get_token(NULL)) == NULL) 
         {
         printf(
            "Error ! Problem in format of ProDom entry %s sequence-line %d\n",
                entry_name, num_seqs+1) ;
         return(NULL) ;
         }

           /* temporarily store start position, if this is first sequence 
              the sequences length isn't known and no memory allocated yet, 
              place it in block sequence structure after memory is allocated */

      for(iptr=ptr; *iptr != '\0' && isdigit(*iptr); iptr++) ;
      if (*iptr != '\0')
         {
         printf(
            "Error ! Problem in format of ProDom entry %s sequence-line %d\n",
                entry_name, num_seqs+1) ;
         printf("A non-digit in the sequence start position %s\n", ptr) ;
         return(NULL) ;
         }

      temp = atoi(ptr) ;

                    /* get 3rd word - sequence end position (no use for it) */
      if ((ptr = get_token(NULL)) == NULL) 
         {
         printf(
            "Error ! Problem in format of ProDom entry %s sequence-line %d\n",
                entry_name, num_seqs+1) ;
         return(NULL) ;
         }

                                              /* get 4th word - the sequence */
      if ((ptr = get_token(NULL)) == NULL) 
         {
         printf(
            "Error ! Problem in format of ProDom entry %s sequence-line %d\n",
                entry_name, num_seqs+1) ;
         return(NULL) ;
         }


           /* should have arrived at the begining of 4th word - the sequence */
                /* find out from the first sequence the sequence length 
                   and use it to allocate memory for the sequence structures */
      if (num_seqs == 0)
	 {
         block->width = strlen(ptr) ;

                          /* following part adapted from 
                             blimps procedure read_block_body by Bill Alford */

         /* allocate space for all the Sequences of the block sequence array */
         CheckMem(
             sequence_pointer = 
                  (Sequence *) 
		  calloc(block->max_sequences,sizeof(Sequence))) ;

	                             /* initialize the block sequences array */
	 block->sequences = sequence_pointer ;

	                                  /* allocate space for all residues */
	 CheckMem(
             residue_pointer = 
                 (Residue *) 
                 calloc(block->width * block->max_sequences, 
			sizeof(Residue))) ;

	                                /* initialize the residues 2-d array */
	 CheckMem(
             block->residues = 
                 (Residue **) calloc(block->max_sequences, sizeof(Residue *))) ;

	                                /* initialize sequences and residues */
         for(i1=0; i1<block->max_sequences; i1++) 
            {
	    sequence_pointer[i1].length = block->width;
	    sequence_pointer[i1].sequence =
 		              &(residue_pointer[i1 * block->width]) ;
	    block->residues[i1] = 
                              &(residue_pointer[i1 * block->width]) ;
	    }
         }

                         /* memory now allocated to block sequence structure 
                                              copy name, position and length */
      strncpy(block->sequences[num_seqs].name, word, SMALL_BUFF_LENGTH) ;
                           /* in case word is longer than SMALL_BUFF_LENGTH 
                                      and thus the last char copied isnt \0 */ 
      block->sequences[num_seqs].name[SMALL_BUFF_LENGTH-1] = '\0' ; 

      block->sequences[num_seqs].position = temp ;

      block->sequences[num_seqs].length = block->width ;

/* process next word - the sequence, check length, change gap symbol "." to "-" */

      if (strlen(ptr) != block->width)
	 {
         printf(
            "Error ! Problem in format of ProDom entry sequence-line %d\n",
                num_seqs+1) ;
         printf("Sequence %s has length of %d instead of expected %d\n",
                block->sequences[num_seqs].name, strlen(ptr), 
	        block->width) ;
         return(NULL) ;
         }

      for(iptr=ptr; *iptr != '\0'; iptr++) if (*iptr == '.') *iptr = '-' ;

    /* next part adopted from blimps  procedure next_cluster by Bill Alford */
                     /* read the sequence from the string into the Sequence */

       rc = read_sequence(&(block->sequences[num_seqs]), AA_SEQ, 0, ptr) ; 
				   /* the Sequence, sequence type, starting */
   				   /* position, string with the sequence    */

                                      /* check to see if there was an error */    
       if (rc < 0) 
          {
                      /* Error, more residues in the sequence than expected */
          printf("Error reading sequence %s in block %s,", 
                 block->sequences[num_seqs].name, block->number) ;
          printf("%d more residues in the sequence than the expected %d.\n",
	         -rc, block->sequences[num_seqs].length) ;
          }
       else if (rc < block->sequences[num_seqs].length) 
          {
        /* Error, not enough residues for the sequence, filling with blanks */
          printf("Error reading sequence %s in block %s,", 
                 block->sequences[num_seqs].name, block->number) ;
          printf("not enough residues to fill the sequence.");
          printf("Filling the rest of the sequence with blanks.\n");

                                                     /* filling with blanks */
    	  for(i1=rc; i1<block->sequences[num_seqs].length; i1++) 
	     block->sequences[num_seqs].sequence[i1] = aa_atob['-'];
          }
       else if (rc > block->sequences[num_seqs].length) 
          {
              /* BIG Error, an undocumented return value from read_sequence */
          printf(
              "read_a_prodom_entry(): Error reading sequence %s in block %s,",
 	         block->sequences[num_seqs].name,
                 block->number) ;
          printf("Undocumented return value, %d, from read_sequence().\n",
                 rc) ;
          } /* else, ret_value == seq.length, OK */

                 /* sequences have no weights give all equal weights of 100 */
       block->sequences[num_seqs].weight =  100.0 ;

          /* assign the sequences to the cluster (space has been allocated) */

       block->clusters[0].num_sequences = block->num_sequences ;

       block->clusters[0].sequences = &(block->sequences[0]) ;

       }

      if (num_seqs < 2)
	 {
         printf("Error ! Not enough sequences (%d) in ProDom entry %s\n",
                num_seqs, block->number) ;
         return(NULL) ;
         }
      else if (num_seqs != block->num_sequences)
         {
         printf("Error ! Actual number of sequences in ProDom entry %s\n",
                block->number) ;
         printf("different than what the entry reports\n") ;
         return(NULL) ;
         }

      min_pos = 10000 ;  /* find min and max start positions of sequences */
      max_pos = 0 ;
      for(i1=0; i1<num_seqs; i1++)
	 {
         if (block->sequences[i1].position > max_pos) 
            max_pos = block->sequences[i1].position ;
         if (block->sequences[i1].position < min_pos) 
            min_pos = block->sequences[i1].position ;
	 }

/* add min and max distance from previous block (sequence start) to Ac line */
      sprintf(word, " distance from previous block=(%d,%d)", 
              min_pos, max_pos);
      strcat(block->ac, word) ;

      sprintf(block->bl, "adapted from ProDom entry; width=%d; seqs=%d;",
              block->width, block->num_sequences) ; 

   return(block) ;
}

/*
 * fprint_matrix
 *   Prints a Matrix data structure to a file.  Primarily for debugging purposes.
 * adapted from blimps3.0.0 print_matrix
 *   Parameters: 
 *     Matrix *matrix:  the matrix to print
 *     FILE   *omfp:   the output matrix file pointer
 *   Error Codes: none
 */

void fprint_matrix(matrix,omfp)
     Matrix *matrix;
     FILE *omfp;
{
  int pos;
  int low, high;
  char c;

  int MATRIX_PRINT_WIDTH ;

  if (WWW_FLAG)
     MATRIX_PRINT_WIDTH = 55 ;
  else
     MATRIX_PRINT_WIDTH = 18 ;

  high = MATRIX_PRINT_WIDTH;
  for (low=0; 
       low<high && low<matrix->width; 
       low = (high+=MATRIX_PRINT_WIDTH) - MATRIX_PRINT_WIDTH) {



  fprintf(omfp,"\n");

/* modified following statements to 
  print matrix column number starting from 1 not 0*/

  if (matrix->width > 99) {
    fprintf(omfp,"  |");
    for (pos=low; pos<high &&  pos<matrix->width; pos++) {
      if (pos+1 > 99) {
	fprintf(omfp,"% 4d", (pos+1)%100);
      }
      else {
	fprintf(omfp,"    ");
      }
    }
  }

  fprintf(omfp,"\n");
  if (matrix->width > 9) {
    fprintf(omfp,"  |");
    for (pos=low; pos<high &&  pos<matrix->width; pos++) {
      if (pos+1 > 9) {
	fprintf(omfp,"% 4d", (pos+1-(((pos+1)/100)*100)) / 10);
      }
      else {
	fprintf(omfp,"    ");
      }
    }
  }
  
  fprintf(omfp,"\n");
  fprintf(omfp,"  |");
  for (pos=low; pos<high &&  pos<matrix->width; pos++) {
    fprintf(omfp,"%4d", ((pos-((pos/10)*10))+1)%10);
  }
  
  fprintf(omfp,"\n");
  fprintf(omfp,"--+");
  for (pos=low; pos<high &&  pos<matrix->width; pos++) {
    fprintf(omfp,"----");
  }

  fprintf(omfp,"\n");
  
/* following part modified not to show B, J, O, U and Z */
  for (c='A'; c<='Y'; c++) {
    switch (c)
      {
      case 'B' : continue ;
      case 'J' : continue ;
      case 'O' : continue ;
      case 'U' : continue ;
      }
    fprintf(omfp,"%c |", c);
    for (pos=low; pos<high &&  pos<matrix->width; pos++) {
      fprintf(omfp,"% 4d", round(matrix->weights[aa_atob[c]][pos]));
    }
    fprintf(omfp,"\n");
  }

/* removed printing of c='*' */

  c = '-';
  fprintf(omfp,"%c |", c);
  for (pos=low; pos<high &&  pos<matrix->width; pos++) {
    fprintf(omfp,"% 4d", round(matrix->weights[aa_atob[c]][pos]));
  }
  fprintf(omfp,"\n");

  }

} /* end of fprint_matrix */
/*---------------------------------------------------------------------
	cluster pairwise scores
-----------------------------------------------------------------------*/
int cluster(score_cutoff, min_cols,  width, pairs)
double score_cutoff;
int min_cols, width;
struct pair *pairs;
{
   int iclus, npair, threshold, s1, s2, px, i, i1, i2;
   int nclus[MAXROWS], icluster[MAXROWS], minclus, oldclus;
   int maxnclus;

   if (min_cols > width) min_cols = width;
   npair = width*(width-1)/2;
   threshold = (int) (100.0 * score_cutoff);

/*  Print scores */
/*   printf("\nThreshold=%d", threshold);
   for (s2=1; s2<width; s2++)
   {
      printf ("\n");
      for (s1=0; s1<s2; s1++)
      {
	 px = INDEX(width, s1, s2);
	 printf(" %.3d", pairs[px].score);
      }
    }
*/

   /*-------Cluster if score exceeds threshold by scanning cols (s1) */
   for (s1=0; s1<width; s1++)
   {
      icluster[s1] = -1;			/* clear out old values */
      nclus[s1] = 0;
   }
   iclus = 0;        				/* cluster number */
   for (s1=0; s1<width-1; s1++)   		/* col = 0, n-2     */
      for (s2=s1+1; s2<width; s2++)	/* row = col+1, n-1 */
      {
	 px = INDEX(width, s1, s2);
	 if (pairs[px].score >= threshold)	/*  cluster this pair */
	 {
/*
printf("s1=%d s2=%d score=%d\n", s1, s2, pairs[px].score);
*/
	    if (icluster[s1] < 0)          /* s1 not yet clustered */
	    {
	       if (icluster[s2] < 0)       /* new cluster */
	       {
		  icluster[s1] = iclus++;
		  icluster[s2] = icluster[s1];
	       }
	       else  				/* use s2's cluster  */
		  icluster[s1] =  icluster[s2];
	    }
	    /*  use s1's cluster if it has one and s2 doesn't */
	    else if (icluster[s1] >= 0 && icluster[s2] < 0)
	       icluster[s2] = icluster[s1];
	    /* merge the two clusters into the lower number */
	    else if (icluster[s1] >= 0 && icluster[s2] >= 0)
	    {
	       minclus = icluster[s1]; oldclus = icluster[s2];
	       if (icluster[s2] < icluster[s1])
	       {
		  minclus = icluster[s2]; oldclus = icluster[s1];
	       }
	       for (i1=0; i1<width; i1++)
		 if (icluster[i1] == oldclus)
		     icluster[i1] = minclus;
	    }
	 }  /* end of if pairs */
      }  /* end of s2 */

   /*---  Set ncluster, get rid of negative cluster numbers --*/
   for (s1=0; s1<width; s1++)
   {
      if (icluster[s1] < 0) 
	  icluster[s1] = iclus++;
   }
   for (s1=0; s1<width; s1++)
	  nclus[icluster[s1]] += 1;

   /*------------ max cluster size -------------------------------------*/
   s2 = 0; i2 = 0;
   maxnclus = 0;
   for (i=0; i< iclus; i++)
   {
      if (nclus[i] > maxnclus) maxnclus = nclus[i];
   }

/*
for (i=0; i<iclus; i++)
{
  printf("clump %d has %d cols: ", i, nclus[i]);
  for (s1=0; s1 < width; s1++)
     if (icluster[s1] == i) printf(" %d", s1);
  printf("\n");
}
*/

   if (maxnclus >= min_cols) return(maxnclus);
   else return(0);

}  /* end of cluster */
