/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "freb.p" */ #include /* freb: frequency table to Delila book Dr. Thomas D. Schneider National Institutes of Health National Cancer Institute Center for Cancer Research Nanobiology Program Molecular Information Theory Group Frederick, Maryland 21702-1201 toms@ncifcrf.gov permanent email: toms@alum.mit.edu (use only if first address fails) http://www.ccrnp.ncifcrf.gov/~toms/ */ /* end of program */ /* begin module version */ #define version 1.16 /* of freb.p 2008 May 21 2008 May 21, 1.16: sum is wrong 2008 May 21, 1.15: multiplier is wrong 2007 Nov 20, 1.14: point to transpose 2007 Jan 10, 1.13: allow real numbers 1999 Dec 13, 1.12: functional 1997 Apr 22, 1.00: origin from frese 1.01 1991 November 30 */ /* end module version */ /* begin module describe.freb */ /* name freb: frequency table to Delila book synopsis freb(frebp: in, book: out, output: out) files frebp: input frequency table (parameters to the program) The first line is the name of the site. The following lines each have a set of numbers, 5 per line, representing first the coordinate and then the numbers of a,c,g and t to use. If the numbers are integers, then those integers are used to create the sequences. The numbers can be real in which case the smallest power of 10 multiplier is used to make the numbers integer. book: sequences which could have produced the frebp frequencies, in Delila book format. output: messages to the user description The freb program converts a table of frequencies to a set of aligned sequences so they may be analyzed. The raw sequences have the same frequencies, but, of course, are not the same as the original sequences. examples documentation see also {program to create a sequence set from a table:} frese.p {program to create a book:} makebk.p {program to transpose the table:} transpose.p {example parameter file:} frebp author Thomas Dana Schneider bugs technical notes */ /* end module describe.freb */ /* begin module freb.const */ #define maxarray 100 /* largest possible array that can be stored */ /* end module freb.const */ /* begin module interact.const */ /* begin module string.const */ #define maxstring 2000 /* the maximum string */ /* end module string.const version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* end module interact.const version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.const ***************************************************/ /* constants needed for book manipulations */ #define dnamax 1024 /* length of dna arrays */ #define namelength 100 /* maximum key name length */ #define linelength 200 /* maximum line readable in book */ /* end module book.const version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module datetime.const */ #define datetimearraylength 19 /* length of dataarray for dates, It is just long enough to include the 4 digit year - solving the year 2000 problem: 1980/06/09 18:49:11 123456789 123456789 1 2 */ /* end module datetime.const version = 'cdatemod.p 1.19 1999Dec13'; */ /* begin module interact.type */ /* begin module string.type */ /* pointer to a string */ typedef struct string { /* a string of characters */ Char letters[maxstring]; /* the letters in the string */ long length; /* the number of characters in the string */ long current; /* the letter we are working on */ Char *next; /* the next string in a series */ } string; /* end module string.type version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* end module interact.type version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.type */ /* types needed for book manipulations */ typedef long chset[5]; /* types defined in book definition */ typedef Char alpha[namelength]; /* this is not alfa */ /* name is a left justified string with blanks following the characters */ typedef struct name { alpha letters; /* zero means an unspecified structure */ char length; } name; typedef struct line { /* a line of characters */ Char letters[linelength]; uchar length; struct line *next; } line; typedef enum { plus, minus, dircomplement, dirhomologous } direction; typedef enum { linear, circular } configuration; typedef enum { on, off } state; typedef struct header { /* header of key */ name keynam; /* key name of structure */ line *fulnam; /* full name of structure */ /* note key */ line *note; } header; /* begin module base.type */ /* define the four nucleotide bases */ typedef enum { a, c, g, t } base; /* end module base.type version = 7.70; {of delmod.p 2005 Sep 15} */ /* sequence types */ typedef short dnarange; /* p2c: freb.p, line 166: * Note: Field width for seq assumes enum base has 4 elements [105] */ typedef uchar seq[(dnamax + 3) / 4]; typedef struct dnastring { seq part; dnarange length; struct dnastring *next; } dnastring; typedef struct orgkey { /* organism key */ header hea; /* genetic map units */ line *mapunit; } orgkey; typedef struct chrkey { /* chromosome key */ header hea; double mapbeg; /* number of genetic map beginning */ /* number of genetic map ending */ double mapend; } chrkey; typedef struct piekey { /* piece key */ header hea; double mapbeg; /* genetic map beginning */ configuration coocon; /* configruation (circular/linear) */ direction coodir; /* direction (+/-) relative to genetic map */ long coobeg; /* beginning nucleotide */ long cooend; /* ending nucleotide */ configuration piecon; /* configruation (circular/linear) */ direction piedir; /* direction (+/-) relative to coordinates */ long piebeg; /* beginning nucleotide */ long pieend; /* ending nucleotide */ } piekey; typedef struct piece { piekey key; dnastring *dna; } piece; typedef struct reference { name pienam; /* name of piece referred to */ double mapbeg; /* genetic map beginning */ direction refdir; /* direction relative to coordinates */ long refbeg; /* beginning nucleotide */ long refend; /* ending nucleotide */ } reference; typedef struct genkey { /* gene key */ header hea; reference ref; } genkey; typedef struct trakey { /* transcript key */ header hea; reference ref; } trakey; typedef struct markey { /* marker key */ header hea; reference ref; state sta; line *phenotype; struct marker *next; } markey; typedef struct marker { markey key; dnastring *dna; } marker; /* end module book.type version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module datetime.type */ /* array for dates */ typedef Char datetimearray[datetimearraylength]; /* end module datetime.type version = 'cdatemod.p 1.19 1999Dec13'; */ Static _TEXT frebp, book; /* files used by this program */ /* begin module book.var */ /* ************************************************************************ */ /* global variables needed for book manipulations */ /* free storage: */ Static line *freeline; /* unused lines */ Static dnastring *freedna; /* unused dnas */ Static boolean readnumber; /* whether to read a number from the notes, or to read in the notes */ Static long number; /* the number of the item just read */ Static boolean numbered; /* true when the item just read is numbered */ Static boolean skipunnum; Static jmp_buf _JL1; /* a control variable to allow skipping of un-numbered items in the book */ /* ************************************************************************ */ /* end module book.var version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module halt */ Static Void halt() { /* stop the program. the procedure performs a goto to the end of the program. you must have a label: label 1; declared, and also the end of the program must have this label: 1: end. examples are in the module libraries. this is the only goto in the delila system. */ printf(" program halt.\n"); longjmp(_JL1, 1); } /* end module halt version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.basis */ /* procedures needed for book manipulations */ /* get procedures should be used for all linked lists of records */ Static Void getline(l) line **l; { /* obtain a line from the free line list or by making a new one */ if (freeline != NULL) { *l = freeline; freeline = freeline->next; } else *l = (line *)Malloc(sizeof(line)); (*l)->length = 0; (*l)->next = NULL; } Static Void getdna(l) dnastring **l; { if (freedna != NULL) { *l = freedna; freedna = freedna->next; } else *l = (dnastring *)Malloc(sizeof(dnastring)); (*l)->length = 0; (*l)->next = NULL; } /* clear procedures should be called each time the records are no longer needed failure to do this may result in a stack overflow. */ Static Void clearline(l) line **l; { /* return a line to the free line list */ line *lptr; if (*l == NULL) return; lptr = *l; *l = (*l)->next; lptr->next = freeline; freeline = lptr; } Static Void writeline(afile, l, carriagereturn) _TEXT *afile; line *l; boolean carriagereturn; { /* write a line to a file, with carriage return if carriagereturn is true. */ long index; /* index to characters in l */ long FORLIM; FORLIM = l->length; for (index = 0; index < FORLIM; index++) putc(l->letters[index], afile->f); if (carriagereturn) putc('\n', afile->f); } Static Void showfreedna() { /* show the freedna list */ long counter = 0; /* count of freedna list */ dnastring *l; /* pointer into freedna list */ l = freedna; while (l != NULL) { counter++; printf("%ld", counter); printf(", length = %d\n", l->length); /* This is illegal according to gpc because one cannot write a pointer to a text file. It can be unearthed for debugging. write(output, ', pointer id: ',l:1); */ l = l->next; } } Static Void cleardna(l) dnastring **l; { /* clear the dna strutures to the free list */ dnastring *lptr; if (*l == NULL) return; lptr = *l; *l = (*l)->next; lptr->next = freedna; freedna = lptr; } Static Void clearheader(h) header *h; { /* clear the header h (remove lines to free storage) */ clearline(&h->fulnam); while (h->note != NULL) clearline(&h->note); } Static Void clearpiece(p) piece **p; { /* clear the dna of the piece */ while ((*p)->dna != NULL) cleardna(&(*p)->dna); clearheader(&(*p)->key.hea); } Static base chartobase(ch) Char ch; { /* convert a character into a base */ base Result; switch (ch) { case 'a': Result = a; break; case 'c': Result = c; break; case 'g': Result = g; break; case 't': Result = t; break; } return Result; } Static Char basetochar(ba) base ba; { /* convert a base into a character */ Char Result; switch (ba) { case a: Result = 'a'; break; case c: Result = 'c'; break; case g: Result = 'g'; break; case t: Result = 't'; break; } return Result; } Static base complement(ba) base ba; { /* take the complement of ba */ base Result; switch (ba) { case a: Result = t; break; case c: Result = g; break; case g: Result = c; break; case t: Result = a; break; } return Result; } Static Char chomplement(b) Char b; { /* create the character complement of base b. I must be getting hungry! */ return (basetochar(complement(chartobase(b)))); } Static long pietoint(p, pie) long p; piece *pie; { /* p is a coordinate on the piece. we want to transform p into a number from 1 to n: an internal coordinate system for easy manipulation of piece coordinates */ /* Note: the dirhomologous and dircomplement are treated as plus and minus directions, which MIGHT NOT BE RIGHT! */ long i; /* an intermediate value */ piekey *WITH; WITH = &pie->key; switch (WITH->piedir) { case dirhomologous: case plus: if (p >= WITH->piebeg) i = p - WITH->piebeg + 1; else i = p - WITH->coobeg + WITH->cooend - WITH->piebeg + 2; break; case dircomplement: case minus: if (p <= WITH->piebeg) i = WITH->piebeg - p + 1; else i = WITH->cooend - p + WITH->piebeg - WITH->coobeg + 2; break; } return i; } Static long inttopie(i, pie) long i; piece *pie; { /* i is in the range 1 to some maximum. it is an internal coordinate system for the program. we want to do a coordinate transformation to obtain a value in the range of the piece called pie: i=1 corresponds to piebeg and i=its maximum corresponds to pieend */ /* Note: the dirhomologous and dircomplement are treated as plus and minus directions, which MIGHT NOT BE RIGHT! */ long p; /* an intermediate value */ piekey *WITH; WITH = &pie->key; switch (WITH->piedir) { case dirhomologous: case plus: p = WITH->piebeg + i - 1; if (p > WITH->cooend) { if (WITH->coocon == circular) p += WITH->coobeg - WITH->cooend - 1; } break; case dircomplement: case minus: p = WITH->piebeg - i + 1; if (p < WITH->coobeg) { if (WITH->coocon == circular) p += WITH->cooend - WITH->coobeg + 1; } break; } return p; } Static long piecelength(pie) piece *pie; { /* return the length of the dna in pie */ return (pietoint(pie->key.pieend, pie)); } /* end module book.basis version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module package.bwrite */ /****************************************************************************/ /* this is a package of procedures for writing books, by gary stormo, aug 17, 1982 */ /* begin module book.bwbasics */ Static Void bwstartline(book) _TEXT *book; { /* start a line of output to the book */ fprintf(book->f, "* "); } Static Void bwline(book, l) _TEXT *book; line *l; { /* write a line to the book */ long i, FORLIM; if (l == NULL) return; bwstartline(book); if (l->length != 0) { FORLIM = l->length; for (i = 0; i < FORLIM; i++) putc(l->letters[i], book->f); } putc('\n', book->f); } Static Void bwtext(book, lines) _TEXT *book; line *lines; { /* write a set of lines to the book */ line *l = lines; while (l != NULL) { bwline(book, l); l = l->next; } } Static Void bwnote(book, note) _TEXT *book; line *note; { /* writes the notes pointed to by 'note' to 'book' */ if (note == NULL) return; fprintf(book->f, "note\n"); bwtext(book, note); fprintf(book->f, "note\n"); } Static Void bwnumber(book, num) _TEXT *book; long num; { /* write a number to the book */ bwstartline(book); fprintf(book->f, "%ld\n", num); /* pascal will expand the field as far as needed */ } Static Void bwreanum(book, reanum) _TEXT *book; double reanum; { /* write a real number to the book */ bwstartline(book); fprintf(book->f, "%1.2f\n", reanum); /* pascal will expand the field */ } Static Void bwstate(book, sta) _TEXT *book; state sta; { /* write a state to the book */ bwstartline(book); switch (sta) { case on: fprintf(book->f, "on\n"); break; case off: fprintf(book->f, "off\n"); break; } } Static Void bwname(book, nam) _TEXT *book; name nam; { /* write a name to the book */ long i; bwstartline(book); for (i = 0; i < nam.length; i++) putc(nam.letters[i], book->f); putc('\n', book->f); } Static Void bwdirect(book, direct) _TEXT *book; direction direct; { /* write a direction to the book */ bwstartline(book); switch (direct) { case dirhomologous: case plus: /* handle case, may not be right */ fprintf(book->f, "+\n"); break; case dircomplement: case minus: /* handle case, may not be right */ fprintf(book->f, "-\n"); break; } } Static Void bwconfig(book, config) _TEXT *book; configuration config; { /* write a configuration to the book */ bwstartline(book); switch (config) { case linear: fprintf(book->f, "linear\n"); break; case circular: fprintf(book->f, "circular\n"); break; } } Static Void bwheader(book, hea) _TEXT *book; header hea; { /* write a key header to the book */ bwname(book, hea.keynam); bwline(book, hea.fulnam); bwnote(book, hea.note); } Static Void bworgkey(book, org) _TEXT *book; orgkey org; { /* write the organism key */ bwheader(book, org.hea); bwline(book, org.mapunit); } Static Void bwchrkey(book, chr) _TEXT *book; chrkey chr; { /* write the chromosome key */ bwheader(book, chr.hea); bwreanum(book, chr.mapbeg); bwreanum(book, chr.mapend); } /* end module book.bwbasics version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.bworg */ Static Void bworg(thefile, org, chropen, orgopen) _TEXT *thefile; orgkey org; boolean *chropen, *orgopen; { /* this writes the organism key 'org' to 'thefile', and returns 'orgopen' as true. if there is already a chromosome or organism open they are closed. */ if (*chropen) { fprintf(thefile->f, "chromosome\n"); *chropen = false; } if (*orgopen) fprintf(thefile->f, "organism\n"); fprintf(thefile->f, "organism\n"); bworgkey(thefile, org); *orgopen = true; } /* end module book.bworg version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.bwchr */ Static Void bwchr(thefile, chr, chropen) _TEXT *thefile; chrkey chr; boolean *chropen; { /* write the chromosome key 'chr' to 'thefile' and return chropen as true. if a chromosome is already open it is closed. */ if (*chropen) fprintf(thefile->f, "chromosome\n"); fprintf(thefile->f, "chromosome\n"); bwchrkey(thefile, chr); *chropen = true; } /* end module book.bwchr version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.bwdna */ Static Void bwdna(thefile, d) _TEXT *thefile; dnastring *d; { /* write the dna pointed to by 'd' to 'thefile' */ long i; /* index to the sequence */ long l; /* index to the number of bases on the line */ boolean newline = true; /* true when a new line should be started */ long FORLIM; fprintf(thefile->f, "dna\n"); while (d != NULL) { FORLIM = d->length; for (i = 1; i <= FORLIM; i++) { if (newline) { bwstartline(thefile); l = 0; newline = false; } fputc(basetochar((base)P_getbits_UB(d->part, i - 1, 1, 3)), thefile->f); l++; if (l % 60 == 0 || i == d->length && d->next == NULL) { /* end of line */ putc('\n', thefile->f); newline = true; } /* p2c: freb.p, line 676: * Note: Using % for possibly-negative arguments [317] */ /* last base */ } d = d->next; } if (!newline) /* last base */ putc('\n', thefile->f); fprintf(thefile->f, "dna\n"); } /* end module book.bwdna version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.bwpie */ Static Void bwpie(thefile, pie) _TEXT *thefile; piece *pie; { /* writes the information pointed to by 'pie' to 'thefile' */ fprintf(thefile->f, "piece\n"); bwheader(thefile, pie->key.hea); bwstartline(thefile); fprintf(thefile->f, "%1.2f\n", pie->key.mapbeg); bwstartline(thefile); if (pie->key.coocon == circular) fprintf(thefile->f, "circular\n"); else fprintf(thefile->f, "linear\n"); bwstartline(thefile); if (pie->key.coodir == plus) fprintf(thefile->f, "+\n"); else fprintf(thefile->f, "-\n"); bwstartline(thefile); fprintf(thefile->f, "%ld\n", pie->key.coobeg); bwstartline(thefile); fprintf(thefile->f, "%ld\n", pie->key.cooend); bwstartline(thefile); if (pie->key.piecon == circular) fprintf(thefile->f, "circular\n"); else fprintf(thefile->f, "linear\n"); bwstartline(thefile); if (pie->key.piedir == plus) fprintf(thefile->f, "+\n"); else fprintf(thefile->f, "-\n"); bwstartline(thefile); fprintf(thefile->f, "%ld\n", pie->key.piebeg); bwstartline(thefile); fprintf(thefile->f, "%ld\n", pie->key.pieend); bwdna(thefile, pie->dna); fprintf(thefile->f, "piece\n"); } /* end module book.bwpie version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.bwref */ Static Void bwref(book, ref) _TEXT *book; reference ref; { /* write a key reference to the book */ bwname(book, ref.pienam); bwreanum(book, ref.mapbeg); bwdirect(book, ref.refdir); bwnumber(book, ref.refbeg); bwnumber(book, ref.refend); } /* end module book.bwref version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.bwgen */ Static Void bwgen(thefile, gene) _TEXT *thefile; genkey gene; { /* this proecdure writes to 'thefile' the information in 'gene', properly formatted; */ fprintf(thefile->f, "gene\n"); bwheader(thefile, gene.hea); bwref(thefile, gene.ref); fprintf(thefile->f, "gene\n"); } /* end module book.bwgen version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.bwtra */ Static Void bwtra(thefile, trans) _TEXT *thefile; trakey trans; { /* this proecdure writes to 'thefile' the information in 'trans', properly formatted; */ fprintf(thefile->f, "transcript\n"); bwheader(thefile, trans.hea); bwref(thefile, trans.ref); fprintf(thefile->f, "transcript\n"); } /* end module book.bwtra version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module book.bwmar */ Static Void bwmar(thefile, mark) _TEXT *thefile; marker mark; { /* this proecdure writes to 'thefile' the information in 'mark', properly formatted; */ long i, FORLIM; fprintf(thefile->f, "marker\n"); bwheader(thefile, mark.key.hea); bwref(thefile, mark.key.ref); bwstate(thefile, mark.key.sta); bwstartline(thefile); FORLIM = mark.key.phenotype->length; for (i = 0; i < FORLIM; i++) putc(mark.key.phenotype->letters[i], thefile->f); putc('\n', thefile->f); bwdna(thefile, mark.dna); fprintf(thefile->f, "marker\n"); } /* end module book.bwmar version = 7.70; {of delmod.p 2005 Sep 15} */ /****************************************************************************/ /* end module package.bwrite version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module getdatetime */ Static Void getdatetime(adatetime) Char *adatetime; { /* Get the date and time into a single array from the system clock. adatetime contains the date: 1980/06/09 18:49:11 ye mo da ho mi se (year, month, day, hour, minute, second) This version works after translation of the pascal by p2c to C and then compiling with gcc. */ Char adate[11], atime[11]; /* adate, atime: alfa; (* ie, packed array[1..10] of char; *) This old method won't work, since the last digit gets cut off! */ Char month[3]; long index; /* index for times */ /* 1 12345678901 adate[13-DEC-1999] atime[17:39:44.00] */ VAXdate(adate); VAXtime(atime); /* writeln(output,'br: adate[',adate,'] atime[',atime,']'); */ /* transfer the year */ for (index = 1; index <= 4; index++) adatetime[index-1] = adate[index+6]; adatetime[4] = '/'; for (index = 4; index <= 6; index++) month[index-4] = adate[index-1]; if (!strncmp(month, "JAN", 3)) { adatetime[5] = '0'; adatetime[6] = '1'; } else if (!strncmp(month, "FEB", 3)) { adatetime[5] = '0'; adatetime[6] = '2'; } else if (!strncmp(month, "MAR", 3)) { adatetime[5] = '0'; adatetime[6] = '3'; } else if (!strncmp(month, "APR", 3)) { adatetime[5] = '0'; adatetime[6] = '4'; } else if (!strncmp(month, "MAY", 3)) { adatetime[5] = '0'; adatetime[6] = '5'; } else if (!strncmp(month, "JUN", 3)) { adatetime[5] = '0'; adatetime[6] = '6'; } else if (!strncmp(month, "JUL", 3)) { adatetime[5] = '0'; adatetime[6] = '7'; } else if (!strncmp(month, "AUG", 3)) { adatetime[5] = '0'; adatetime[6] = '8'; } else if (!strncmp(month, "SEP", 3)) { adatetime[5] = '0'; adatetime[6] = '9'; } else if (!strncmp(month, "OCT", 3)) { adatetime[5] = '1'; adatetime[6] = '0'; } else if (!strncmp(month, "NOV", 3)) { adatetime[5] = '1'; adatetime[6] = '1'; } else if (!strncmp(month, "DEC", 3)) { adatetime[5] = '1'; adatetime[6] = '2'; } adatetime[7] = '/'; for (index = 7; index <= 8; index++) adatetime[index+1] = adate[index-7]; /* replace blanks with spaces in dates */ if (adatetime[5] == ' ') adatetime[5] = '0'; if (adatetime[8] == ' ') adatetime[8] = '0'; adatetime[10] = ' '; for (index = 10; index <= 17; index++) adatetime[index+1] = atime[index-10]; for (index = 19; index <= datetimearraylength + 1; index++) adatetime[index] = ' '; } /* end module getdatetime version = 'cdatemod.p 1.19 1999Dec13'; */ /* begin module writedatetime */ Static Void writedatetime(thefile, adatetime) _TEXT *thefile; Char *adatetime; { /* expand the date and time out and print in the file */ long index; /* index of datetime */ for (index = 0; index < datetimearraylength; index++) putc(adatetime[index], thefile->f); } /* end module writedatetime version = 'cdatemod.p 1.19 1999Dec13'; */ /* begin module interact.clearstring */ /* begin module clearstring */ Static Void clearstring(ribbon) string *ribbon; { /* empty the string */ long index; /* to the ribbon */ for (index = 0; index < maxstring; index++) ribbon->letters[index] = ' '; ribbon->length = 0; ribbon->current = 0; } /* clearstring */ Static Void initializestring(ribbon) string *ribbon; { /* start the string with a nil pointer. This routine should be called before doing linked list work. This allows the standard string routines to clear the string without killing the pointer. */ clearstring(ribbon); ribbon->next = NULL; } /* initializestring */ /* end module clearstring version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* end module interact.clearstring version = 7.70; {of delmod.p 2005 Sep 15} */ /* begin module interact.getstring */ Static Void getstring(afile, buffer, gotten) _TEXT *afile; string *buffer; boolean *gotten; { /* get a string from a file not using string calls. this lets one obtain lines from a file without interactive prompts */ long index = 0; /* of buffer */ clearstring(buffer); if (BUFEOF(afile->f)) { *gotten = false; return; } while (!P_eoln(afile->f) && index < maxstring) { index++; buffer->letters[index-1] = getc(afile->f); if (buffer->letters[index-1] == '\n') buffer->letters[index-1] = ' '; } if (!P_eoln(afile->f)) { printf(" getstring: a line exceeds maximum string size (%ld)\n", (long)maxstring); halt(); } buffer->length = index; buffer->current = 1; fscanf(afile->f, "%*[^\n]"); getc(afile->f); *gotten = true; } /* getstring */ /* end module interact.getstring version = 4.20; (@ of prgmod.p 1997 March 15 */ /* begin module interact.writestring */ Static Void writestring(tofile, s) _TEXT *tofile; string *s; { /* write the string s to file tofile, no writeln */ long i; /* index to s */ long FORLIM; FORLIM = s->length; for (i = 0; i < FORLIM; i++) putc(s->letters[i], tofile->f); } /* writestring */ /* end module interact.writestring version = 4.20; (@ of prgmod.p 1997 March 15 */ /* begin module fillname */ Static Void fillname(thename, n) string thename; name *n; { /* fill the name into the name type */ long i; /* index to s */ for (i = 0; i < thename.length; i++) n->letters[i] = thename.letters[i]; n->length = thename.length; /* name = record letters: alpha; length: 0..namelength (* zero means an unspecified structure *) end; */ } /* fillname */ /* end module fillname */ /* begin module fillline */ Static Void fillline(thename, l) string thename; line **l; { /* fill the name into the line */ long i; /* index to s */ for (i = 0; i < thename.length; i++) (*l)->letters[i] = thename.letters[i]; (*l)->length = thename.length; (*l)->next = NULL; /* lineptr = ^line; line = record (* a line of characters *) letters: packed array [1..linelength] of char; length: 0..linelength; next: lineptr end; */ } /* fillline */ /* end module fillline */ /* begin module fillhead */ Static Void fillhead(thename, head) string thename; header *head; { /* fill the header information */ fillname(thename, &head->keynam); head->fulnam = (line *)Malloc(sizeof(line)); fillline(thename, &head->fulnam); head->note = NULL; } /* Local variables for numberdigit: */ struct LOC_numberdigit { long number, place; /* the exponent of logplace */ long absolute; /* the absolute value of number */ Char acharacter; /* the character to be returned */ } ; Local Void digit(LINK) struct LOC_numberdigit *LINK; { /* extract a digit at the place position */ long tenplace; /* ten times place */ long z; /* an intermediate value */ long d; /* the digit extracted */ tenplace = LINK->place * 10; z = LINK->absolute - LINK->absolute / tenplace * tenplace; if (LINK->place == 1) d = z; else d = z / LINK->place; switch (d) { case 0: LINK->acharacter = '0'; break; case 1: LINK->acharacter = '1'; break; case 2: LINK->acharacter = '2'; break; case 3: LINK->acharacter = '3'; break; case 4: LINK->acharacter = '4'; break; case 5: LINK->acharacter = '5'; break; case 6: LINK->acharacter = '6'; break; case 7: LINK->acharacter = '7'; break; case 8: LINK->acharacter = '8'; break; case 9: LINK->acharacter = '9'; break; } } /* digit */ Local Void sign(LINK) struct LOC_numberdigit *LINK; { /* put a negative sign out or a positive sign */ if (LINK->number < 0) LINK->acharacter = '-'; else LINK->acharacter = '+'; } /* sign */ /* end module fillhead */ /* begin module numberdigit */ Static Char numberdigit(number_, logplace) long number_, logplace; { /* return the digit at the place value ('logplace') position of number. example: numberdigit(13625, 3) = 3 numberdigit(13625, 4) = 1 */ struct LOC_numberdigit V; long count; /* used to make place */ V.number = number_; V.place = 1; for (count = 1; count <= logplace; count++) V.place *= 10; if (V.number == 0) { if (V.place == 1) V.acharacter = '0'; else V.acharacter = ' '; return V.acharacter; } V.absolute = labs(V.number); if (V.absolute < V.place / 10) { V.acharacter = ' '; return V.acharacter; } if (V.absolute >= V.place) digit(&V); else sign(&V); return V.acharacter; } /* numberdigit */ #define basis 3 /* location of zero digit of number */ #define numberlength 10 /* length of number */ /* end module numberdigit version = 4.20; (@ of prgmod.p 1997 March 15 */ /* begin module mknumber */ Static Void mknumber(n, l) long n; line **l; { /* make the number n into the line l */ Char c_; /* possible character of the number */ long digit; /* index to the number */ long fillspot = basis; /* spot in the letters to fill */ line *WITH; WITH = *l; for (digit = numberlength; digit >= 0; digit--) { c_ = numberdigit(n, digit); WITH->letters[fillspot-1] = c_; if (c_ != ' ' && c_ != '+') fillspot++; } WITH->length = basis + numberlength; } #undef basis #undef numberlength #define multmax 1000000L /* maximum multiplier */ #define debugging false /* set true to watch the process */ /* end module mknumber */ /* begin module findmultiplier */ Static Void findmultiplier(x, multiplier) double x; long *multiplier; { /* find the multiplier to multiply the real number x by so that there are only zeros after the decimal place. Use multiples of 10 and use the previous multiplier value to start with. */ boolean done = false; /* done searching for the multiplier? */ if (debugging) printf("findmultiplier\n"); if (debugging) printf("findmultiplier: x = %10.5f\n", x); while (!done) { if (debugging) printf("findmultiplier: multiplier = %ld\n", *multiplier); if (debugging) printf("round(multiplier*x) = %ld\n", (long)floor(*multiplier * x + 0.5)); if (debugging) printf("trunc(multiplier*x) = %ld\n", (long)(*multiplier * x)); if ((long)floor(*multiplier * x + 0.5) == (long)(*multiplier * x)) done = true; else *multiplier *= 10; if (*multiplier > multmax) done = true; } } /* findmultiplier */ #undef multmax #undef debugging /* end module findmultiplier */ /* begin module freb.themain */ Static Void themain(frebp, book) _TEXT *frebp, *book; { /* the main procedure of the program */ long na, nc, ng, nt; /* numbers of bases */ double naReal, ncReal, ngReal, ntReal; /* real numbers of bases */ piece *apiece; chrkey chr; /* chromosome info */ boolean chropen = false, orgopen = false; /* open or closed data types */ long DNAstore; /* given coordinate as stored in DNA data structure */ long dummycounter = 1; /* ignore the counts given */ long dummycounterprevious = -LONG_MAX; /* previous dummycounter */ boolean gotten; /* got the name? */ long i; /* index to note numbers */ long l; /* index to storage */ long lstore; /* coordinate for storage */ boolean kill = false; /* kill the book: bad table */ long n; /* count of the sequences produced */ string thename; /* the name of the matrix */ long maxlength = 0; /* longest sequence length coordinate */ long maxtotal = 0; /* the highest total value of a,c,g,t */ long multiplier; /* number to multiply input numbers by */ long previousmultiplier = -LONG_MAX; /* previous multiplier */ long newtotal; /* the current total value of a,c,g,t */ orgkey org; /* organism info */ long q; /* position across the table */ boolean spat; /* have we spat out a base? */ long store[maxarray][5]; /* for storing the table */ long nl[maxarray]; /* number of bases at position l */ long nowfrom; /* range from, decreasing from thefrom */ long nowto; /* range to, decreasing from theto */ long requestedfrom; /* from value requested in file */ datetimearray thedate; /* now */ long thefrom; /* range from */ long theto; /* range to */ boolean up = true; /* the n(l) is going up */ long zerobase; /* the zero coordinate in the range 1..n */ _TEXT TEMP; piekey *WITH; line *WITH1; dnastring *WITH3; printf("freb %4.2f\n", version); if (*frebp->name != '\0') { if (frebp->f != NULL) frebp->f = freopen(frebp->name, "r", frebp->f); else frebp->f = fopen(frebp->name, "r"); } else rewind(frebp->f); if (frebp->f == NULL) _EscIO2(FileNotFound, frebp->name); RESETBUF(frebp->f, Char); getstring(frebp, &thename, &gotten); if (!gotten) { printf("empty frebp file\n"); halt(); } TEMP.f = stdout; *TEMP.name = '\0'; writestring(&TEMP, &thename); putchar('\n'); printf(" l n(l)\n"); while (!BUFEOF(frebp->f)) { fscanf(frebp->f, "%ld%lg%lg%lg%lg%*[^\n]", &dummycounter, &naReal, &ncReal, &ngReal, &ntReal); getc(frebp->f); /* write (output,dummycounter:5, ' ',naReal:5:1, ' ',ncReal:5:1, ' ',ngReal:5:1, ' ',ntReal:5:1); */ if (dummycounterprevious == -LONG_MAX) { /* allow the initial counter to be anything */ dummycounterprevious = dummycounter - 1; requestedfrom = dummycounter; l = requestedfrom; } if (dummycounter != dummycounterprevious + 1) { printf(" WARNING: skipped numbers in original numbering!\n"); /* If we skipped a position, add one to the requested from. so -3 -2 -1 1 2 3 is set to -2 -1 0 1 2 3 */ requestedfrom += dummycounter - dummycounterprevious - 1; } dummycounterprevious = dummycounter; l++; /* l just keeps marching along */ multiplier = 1; findmultiplier(naReal, &multiplier); findmultiplier(ncReal, &multiplier); findmultiplier(ngReal, &multiplier); findmultiplier(ntReal, &multiplier); if (previousmultiplier == -LONG_MAX) { /* writeln(output, ' using multiplier ', multiplier:1); */ previousmultiplier = multiplier; } else { if (previousmultiplier != multiplier) { /* write (output, ' multiplier changed to ', multiplier:1); writeln(output, ' - using ', previousmultiplier:1); */ multiplier = previousmultiplier; /* write (output, '-'); */ } } na = (long)floor(multiplier * naReal + 0.5); nc = (long)floor(multiplier * ncReal + 0.5); ng = (long)floor(multiplier * ngReal + 0.5); nt = (long)floor(multiplier * ntReal + 0.5); maxlength++; if (maxlength > maxarray) { printf("the table is too wide, increase constant maxarry\n"); halt(); } /* store[maxlength,0] := maxlength; */ store[maxlength-1][0] = l; store[maxlength-1][1] = na; store[maxlength-1][2] = nc; store[maxlength-1][3] = ng; store[maxlength-1][4] = nt; newtotal = na + nc + ng + nt; /* writeln(output,maxlength:3,' ',newtotal:5); */ printf("%3ld %5ld\n", l, newtotal); nl[maxlength-1] = newtotal; if (newtotal <= maxtotal) { if (newtotal < maxtotal) up = !up; continue; } maxtotal = newtotal; zerobase = maxlength; if (!up) { printf("n(l) goes up then down then up again!\n"); up = true; kill = true; } /* this mechanism can be dropped probably because rounded numbers can be smaller */ } /* thefrom := 1 - zerobase; theto := maxlength - zerobase; */ thefrom = requestedfrom; theto = maxlength + requestedfrom - 1; printf("total number of sequences to make: %ld\n", maxtotal); printf("maximum length of sequences to make: %ld\n", maxlength); printf("from %ld to %ld\n", thefrom, theto); /* begin to write the book */ if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "w", book->f); else book->f = fopen(book->name, "w"); } else { if (book->f != NULL) rewind(book->f); else book->f = tmpfile(); } if (book->f == NULL) _EscIO2(FileNotFound, book->name); SETUPBUF(book->f, Char); getdatetime(thedate); bwstartline(book); writedatetime(book, thedate); fprintf(book->f, ", "); writedatetime(book, thedate); fprintf(book->f, ", "); writestring(book, &thename); putc('\n', book->f); fillhead(thename, &org.hea); org.mapunit = (line *)Malloc(sizeof(line)); fillline(thename, &org.mapunit); fillhead(thename, &chr.hea); chr.mapbeg = thefrom; chr.mapend = theto; bworg(book, org, &chropen, &orgopen); bwchr(book, chr, &chropen); apiece = (piece *)Malloc(sizeof(piece)); WITH = &apiece->key; fillhead(thename, &WITH->hea); WITH->hea.note = (line *)Malloc(sizeof(line)); WITH1 = WITH->hea.note; for (i = 0; i < linelength; i++) WITH1->letters[i] = ' '; WITH1->length = 5; WITH1->letters[0] = '#'; WITH1->next = NULL; WITH->mapbeg = 0.0; WITH->coocon = linear; WITH->coodir = plus; WITH->coobeg = thefrom; WITH->cooend = theto; WITH->piecon = linear; WITH->piedir = plus; WITH->piebeg = thefrom; WITH->pieend = theto; apiece->dna = (dnastring *)Malloc(sizeof(dnastring)); WITH3 = apiece->dna; WITH3->length = maxlength; WITH3->next = NULL; /* for testing, output should be similar to frebp: */ for (l = 0; l < maxlength; l++) { for (q = 0; q <= 4; q++) { printf("%4ld", store[l][q]); if (q == 0) printf(" | "); } putchar('\n'); } nowfrom = thefrom; nowto = theto; for (n = 1; n <= maxtotal; n++) { /* create the total number of sequences */ /* (* determine current range *) while nl[nowfrom-thefrom+1] <= 0 do begin nowfrom := nowfrom + 1; if nowfrom > nowto then begin writeln(output,'program error, nowfrom > nowto'); writeln(output,'nowfrom = ',nowfrom:1); writeln(output,'nowto = ',nowto :1); halt; end; end; while nl[nowto-theto+1] <= 0 do begin nowto := nowto - 1; if nowfrom > nowto then begin writeln(output,'program error, nowfrom > nowto'); writeln(output,'nowfrom = ',nowfrom:1); writeln(output,'nowto = ',nowto :1); halt; end; end; apiece^.key.piebeg := nowfrom; apiece^.key.pieend := nowto; apiece^.dna^.length := nowto - nowfrom + 1; */ nowfrom = thefrom; nowto = theto; apiece->key.piebeg = nowfrom; apiece->key.pieend = nowto; apiece->dna->length = nowto - nowfrom + 1; lstore = nowfrom - thefrom; for (l = nowfrom; l <= nowto; l++) { /* create one sequence */ DNAstore = l - nowfrom; lstore++; q = 1; spat = false; while (!spat) { if (store[lstore-1][q] > 0) { switch (q) { case 1: P_clrbits_B(apiece->dna->part, DNAstore, 1, 3); break; case 2: P_clrbits_B(apiece->dna->part, DNAstore, 1, 3); P_putbits_UB(apiece->dna->part, DNAstore, (int)c, 1, 3); break; case 3: P_clrbits_B(apiece->dna->part, DNAstore, 1, 3); P_putbits_UB(apiece->dna->part, DNAstore, (int)g, 1, 3); break; case 4: P_putbits_UB(apiece->dna->part, DNAstore, (int)t, 1, 3); break; } store[lstore-1][q]--; nl[lstore-1]--; spat = true; continue; } q++; if (q > 4) q = 1; if (nl[lstore-1] <= 0) spat = true; } } mknumber(n, &apiece->key.hea.note); bwpie(book, apiece); } fprintf(book->f, "chromosome\n"); fprintf(book->f, "organism\n"); if (!kill) return; printf("BOOK IS KILLED because of up and down\n"); if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "w", book->f); else book->f = fopen(book->name, "w"); } else { if (book->f != NULL) rewind(book->f); else book->f = tmpfile(); } if (book->f == NULL) _EscIO2(FileNotFound, book->name); SETUPBUF(book->f, Char); fprintf(book->f, "halt: bad book\n"); } /* end module freb.themain */ main(argc, argv) int argc; Char *argv[]; { PASCAL_MAIN(argc, argv); if (setjmp(_JL1)) goto _L1; book.f = NULL; strcpy(book.name, "book"); frebp.f = NULL; strcpy(frebp.name, "frebp"); themain(&frebp, &book); _L1: if (frebp.f != NULL) fclose(frebp.f); if (book.f != NULL) fclose(book.f); exit(EXIT_SUCCESS); } /* End. */