/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "patlrn.p" */ #include /* patlrn - pattern learning program by gary stormo (modified by tom schneider) modules needed: delman, delmods, auxmods */ /* end of program */ /* begin module version */ #define version 3.31 /* of patlrn.p 1999 dec 13 1999 Dec 13, 3.31: y2k upgrade 1998 July 9: upgrade to new alist 1995 Aug 30: probably conversion to unix origin july 9, 1982 */ /* end module version */ /* begin module describe.patlrn */ /* name patlrn: pattern learning synopsis patlrn(funcbook: in, funcinst: in, nfuncbook: in, nfuncinst: in, pattern: out, start: in, minmax: in, ignore: in, patlrnp: in, output: out) files funcbook: the book of sequences belonging to the functional class; funcinst: the instructions for funcbook, for aligning the sequences; nfuncbook: the book of sequences for the nonfunctional class; nfuncinst: the instructions for nfuncbook, for aligning the seqs; pattern: the resulting wmatrix which separates the classes; start: a matrix for initializing wmatrix to. it is initialized to all 0's if this file is empty; minmax: to set the values of funcmin (the minimum value for a functional sequence) and nfuncmax (the maximum value for a nonfunctional sequence). if this file is empty they are set to 1 and 0, respectively, and vary along with the matrix; ignore: a file specifying regions of the sequences which are to be ignored in the learning process; the maximum number of regions which can be ignored is set by the constant 'maxignore'; the file must contain two integers per line, the first specifying the 5' end and the second the 3' end of the region to be ignored. patlrnp: parameter file for setting maxtimes, the number of times through all the sequences before stopping without a solution; output: for messages to the user. description patlrn uses the 'perceptron' algorithm to find a weighting function (a 'wmatrix') which serves to distinguish the sequences in the two classes from one another. our paper, stormo et.al., nar 10, 2995 (1982), describes the algorithm in detail and gives an example of its use. see also patlst.p, patana.p, patser.p, patval.p, sepa.p author gary d. stormo (modified by tom schneider) bugs the section of code for ignoring regions of the sequences in the learning process (i.e., when the file 'ignore' is not empty) has been overlayed over the rest of the code, rather than worked into it, and consequently, using this feature can be quite inefficient. technical note the program will be more efficient if the constant 'dnamax' in the module 'book.const' is made to be the size of the sequences used by the program. for instance, setting it to whatever 'maxmatrix' is would be a good idea. */ /* end module describe.patlrn */ /* LOCK begin module book.const */ /* constants needed for book manipulations */ /* THIS MODULE IS LOCKED SO THAT THE DNAMAX IS RESTRICTED FOR CONSERVATION OF MEMORY */ #define dnamax 100 /* length of dna arrays */ #define namelength 100 /* maximum key name length */ #define linelength 80 /* maximum line readable in book */ /* LOCK end module book.const version = 'delmod 6.87 98 Feb 27 tds/gds' */ /* 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 matrix.const */ #define maxmatrix 120 /* the maximum size of a pattern matrix */ /* end module matrix.const version = 'auxmod 1.40 94 Sep 5 gds/tds'; */ #define maxignore 10 /* maximum number of regions to ignore */ /* begin module interact.const */ /* begin module string.const */ #define maxstring 150 /* the maximum string */ /* end module string.const version = 4.39; (@ of prgmod.p 1999 November 28 */ /* end module interact.const version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module filler.const */ #define fillermax 50 /* the size of the filler array for a string */ /* end module filler.const version = 4.21; (@ of prgmod.p 1997 October 22 */ /* 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.39; (@ of prgmod.p 1999 November 28 */ /* end module interact.type version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module filler.type */ /* the following is an array used to fill a string. it is convenient to have it much shorter than the maxstring, so that it is easy to fill the string using procedure fillstring. the user must declare the value of constant fillermax. */ typedef Char filler[fillermax]; /* end module filler.type version = 4.21; (@ of prgmod.p 1997 October 22 */ /* begin module trigger.type */ typedef struct trigger { /* an object to be searched for */ string seek; /* the characters looked for */ long state; /* how close to triggering we are */ boolean skip; /* trigger not found- skip the line */ /* the trigger was found */ boolean found; } trigger; /* end module trigger.type version = 4.21; (@ of prgmod.p 1997 October 22 */ /* begin module datetime.type */ /* array for dates */ typedef Char datetimearray[datetimearraylength]; /* end module datetime.type version = 'cdatemod.p 1.19 1999Dec13'; */ /* 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]; char 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.40; {of delmod.p 2000 Feb 18} */ /* sequence types */ typedef char dnarange; /* p2c: patlrn.p, line 190: * 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.40; {of delmod.p 2000 Feb 18} */ /* begin module matrix.type */ typedef long matrix[4][maxmatrix]; /* a pattern matrix */ /* end module matrix.type version = 'auxmod 1.40 94 Sep 5 gds/tds'; */ typedef struct alpiece { long length, alignedbase; dnastring *dna; struct alpiece *next; } alpiece; typedef boolean sequenceclass; typedef enum { fiveprime, threeprime } ends; /* endpoints of ignoring regions */ /* 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; /* a control variable to allow skipping of un-numbered items in the book */ /* ************************************************************************ */ /* end module book.var version = 7.40; {of delmod.p 2000 Feb 18} */ Static _TEXT patlrnp; /* parameter file, to specify 'maxtimes', the number of times through the sequences before stopping without a solution */ Static _TEXT pattern; /* the output solution weighting function */ Static _TEXT ignore; /* file of integers, two per line, specifying the endpoints of regions to be ignored (relative to aligned base) */ Static _TEXT minmax; /* file of two integers, the first to set funcmin and the second to set nfuncmax. if this file is empty they will start at 0 and -1 and vary with the matrix. */ Static _TEXT start; /* file used to initialize wmatrix. if this file is empty it will be initialized as all 0's. the format of the file must be the same as the output of this program. */ Static _TEXT funcbook; /* book of functional sequences */ Static _TEXT nfuncbook; /* book of nonfunctional sequences */ Static _TEXT funcinst; /* inst for aligning functional pieces */ Static _TEXT nfuncinst; /* inst for aligning nonfunctional pieces */ Static long maxtimes; /* the number of times through the sequences before stopping without a solution */ Static long maxaligned; /* maximum bases up to (and including) aligned base */ Static long maxafter; /* maximum bases after aligned base */ Static long width; /* width of seqmatrix (= maxaligned + maxafter) */ Static alpiece *funcpie; /* pointer to list of functional pieces */ Static alpiece *nfuncpie; /* pointer to list of nonfunctional pieces */ Static alpiece *first[2]; /* pointer to first pieces */ Static piece *apiece; /* used by align routine to store piece */ Static matrix wmatrix; /* weight function as a matrix */ Static long changes; /* number of times wmatrix has changed during this run */ Static long funcmin; /* minimum 'valu' for functional sequences and */ Static long nfuncmax; /* maximum 'valu' for nonfunctional sequences. */ /* see procedure evaluate for details of how 'valu' is determined */ Static boolean varthresh; /* true if program determines funcmin and nfuncmax, false if they are set by minmax */ Static boolean done; /* true if program is to terminate */ Static sequenceclass seqclass; /* the type of sequence being used */ Static sequenceclass mostseqs; /* the class with the most sequences */ Static boolean functional; /* functional = true, nonfunctional = false */ Static boolean nonfunctional; /* constants for seqclass variables */ Static datetimearray adatetime; /* for dating output */ Static long timesthru; /* number of times through all the sequences; must be <= maxtimes */ Static long ignorebases[2][maxignore]; /* array of endpoints of regions to ignore, read from input file ignore */ Static long theline; /* line number of the book */ Static jmp_buf _JL1; /* begin module package.primitive */ /* ************************************************************************ */ /* 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.40; {of delmod.p 2000 Feb 18} */ /* begin module copyaline */ Static Void copyaline(fin, fout) _TEXT *fin, *fout; { /* copy a line from file fin to file fout */ while (!P_eoln(fin->f)) { putc(P_peek(fin->f), fout->f); getc(fin->f); } fscanf(fin->f, "%*[^\n]"); getc(fin->f); putc('\n', fout->f); } /* copyaline */ /* end module copyaline version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module copylines */ Static long copylines(fin, fout, n) _TEXT *fin, *fout; long n; { /* copy n lines of file fin to file fout. the actual number of lines copied is returned. */ long index = 0; /* the current line number */ while (!BUFEOF(fin->f) && index < n) { copyaline(fin, fout); index++; } return index; } /* copylines */ /* end module copylines version = 7.40; {of delmod.p 2000 Feb 18} */ /* ************************************************************************ */ /* end module package.primitive version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module package.trigger */ /* ************************************************************************ */ /* begin module interact.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 */ /* end module interact.clearstring version = 4.21; (@ of prgmod.p 1997 October 22 */ /* 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.21; (@ of prgmod.p 1997 October 22 */ /* begin module filler.fillstring */ Static Void fillstring(s, a_) string *s; Char *a_; { /* this procedure makes it reasonably easy to fill the string s with characters. one calls the procedure as: */ /* 1 2 3 4 5 */ /* 12345678901234567890123456789012345678901234567890 */ /* fillstring(s, 'this-is-the-string '); the two comments make it easy to line the characters up. also, for this example, it was assumed that the length of filler as defined by the constant fillermax was 50. */ long length = fillermax; /* of the string without trailing blanks */ long index; /* of s */ clearstring(s); while (length > 1 && a_[length-1] == ' ') length--; if (length == 1 && a_[length-1] == ' ') { printf("fillstring: the string is empty\n"); halt(); } for (index = 0; index < length; index++) s->letters[index] = a_[index]; s->length = length; s->current = 1; } /* fillstring */ /* end module filler.fillstring version = 4.21; (@ of prgmod.p 1997 October 22 */ /* begin module filler.filltrigger */ Static Void filltrigger(t_, a_) trigger *t_; Char *a_; { /* fill the trigger t */ fillstring(&t_->seek, a_); } /* fillstring */ /* end module filler.filltrigger version = 4.21; (@ of prgmod.p 1997 October 22 */ /* begin module trigger.proc */ /* this module allows one to scan a series of characters, as from an array or a file, and to "trigger" or detect a simple string in the series. the advantage of the trigger is that several triggers can "observe" a stream of characters at once, each looking for a different thing. some other modules required: interact.const, interact.type */ Static Void resettrigger(t_) trigger *t_; { /* reset the trigger to ground state */ t_->state = 0; t_->skip = false; t_->found = false; } /* resettrigger */ Static Void testfortrigger(ch, t_) Char ch; trigger *t_; { /* look at the character ch. if it is part of the trigger (at the current trigger state), then the trigger state goes higher. if it is not part of the trigger then the trigger state is reset, skip is true and one should skip onward to find the trigger. if the trigger is found, found is true. 1996 Sep 12: Bug found! In the case of a trigger "ab", the program used to miss it for situations like "aab". This was because at the first a it would step up. Then it would see the second a and recognize that was not part of ab. It would fail to realize that it could be the start of a new one. The code now accounts for that possibility. */ t_->state++; /* writestring(list,seek); writeln(list,'testfortrigger seek.letters[',state:1,']:', seek.letters[state],' ch:',ch); */ if (t_->seek.letters[t_->state - 1] == ch) { t_->skip = false; if (t_->state == t_->seek.length) t_->found = true; else t_->found = false; return; } /* it failed. But wait! It could be the beginning of a NEW trigger string! */ if (t_->seek.letters[0] == ch) { t_->state = 1; t_->skip = false; t_->found = false; return; } t_->state = 0; t_->skip = true; t_->found = false; /* reset trigger */ } /* testfortrigger */ /* end module trigger.proc version = 4.21; (@ of prgmod.p 1997 October 22 */ /* begin module skipblanks */ Static Void skipblanks(thefile) _TEXT *thefile; { /* skip over blanks until a non-blank, or end of line, is found */ while ((P_peek(thefile->f) == ' ') & (!P_eoln(thefile->f))) getc(thefile->f); } Static Void skipnonblanks(thefile) _TEXT *thefile; { /* skip over nonblanks until a blank, or end of line, is found */ while ((P_peek(thefile->f) != ' ') & (!P_eoln(thefile->f))) getc(thefile->f); } Static Void skipcolumn(thefile) _TEXT *thefile; { /* skip over a data column */ skipblanks(thefile); skipnonblanks(thefile); } /* end module skipblanks version = 4.21; (@ of prgmod.p 1997 October 22 */ /* ************************************************************************ */ /* end module package.trigger version = 4.21; (@ of prgmod.p 1997 October 22 */ /* begin module package.align */ /* ************************************************************************ */ /* begin module package.getpiece */ /* ************************************************************************ */ /* begin module package.brpiece */ /* ************************************************************************ */ /* 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 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", l->length); printf(", pointer id: 0x%.8lx\n", (long)l); l = l->next; } } Static Void cleardna(l) dnastring **l; { 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 */ long i; /* an intermediate value */ piekey *WITH; WITH = &pie->key; switch (WITH->piedir) { case plus: if (p >= WITH->piebeg) i = p - WITH->piebeg + 1; else i = p - WITH->coobeg + WITH->cooend - WITH->piebeg + 2; break; 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 */ long p; /* an intermediate value */ piekey *WITH; WITH = &pie->key; switch (WITH->piedir) { case plus: p = WITH->piebeg + i - 1; if (p > WITH->cooend) { if (WITH->coocon == circular) p += WITH->coobeg - WITH->cooend - 1; } break; 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.40; {of delmod.p 2000 Feb 18} */ /* begin module book.getto */ Static Char getto(thefile, theline, ch) _TEXT *thefile; long *theline; long *ch; { /* search the file for a character in the first line which is a member of the set ch. Note: on 1999 March 10 the definition of this function was cleaned up. Instead of putting thefile on the line AFTER the charcter ch has been found, it puts thefile ON the line. Other routines like brdna and brpiece have to move to the next line themselves. This makes getto give the OBJECT. */ Char achar = ' '; /* a character in thefile */ boolean done = false; /* done finding achar */ while (!done) { if (BUFEOF(thefile->f)) { done = true; break; } achar = P_peek(thefile->f); if (P_inset(achar, ch)) { done = true; break; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } if (P_inset(achar, ch)) return achar; else { return ' '; /* The old method - while (not(achar in ch)) and (not eof(thefile)) do begin readln(thefile,achar); theline := succ(theline) end; if (achar in ch) then getto:=achar else getto:=' ' */ } } /* end module book.getto version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.skipstar */ Static Void skipstar(thefile) _TEXT *thefile; { /* skip start of line (or star = '*'). */ if (BUFEOF(thefile->f)) { printf(" procedure skipstar: end of book found\n"); halt(); return; } if (P_peek(thefile->f) != '*') { printf(" procedure skipstar: bad book\n"); printf(" \"*\" expected as first character on the line, but \"%c\" was found\n", P_peek(thefile->f)); halt(); } getc(thefile->f); /* skip the star */ if (P_peek(thefile->f) != ' ') { /* skip the blank */ printf(" procedure skipstar: bad book\n"); printf(" \"* \" expected on a line but \"*%c\" was found\n", P_peek(thefile->f)); halt(); } getc(thefile->f); } /* skipstar */ /* end module book.skipstar version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brreanum */ Static Void brreanum(thefile, theline, reanum) _TEXT *thefile; long *theline; double *reanum; { /* read a real number from the file */ skipstar(thefile); fscanf(thefile->f, "%lg%*[^\n]", reanum); getc(thefile->f); (*theline)++; } /* end module book.brreanum version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brnumber */ Static Void brnumber(thefile, theline, num) _TEXT *thefile; long *theline, *num; { /* read a number from the file */ skipstar(thefile); fscanf(thefile->f, "%ld%*[^\n]", num); getc(thefile->f); (*theline)++; } /* end module book.brnumber version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brname */ Static Void brname(thefile, theline, nam) _TEXT *thefile; long *theline; name *nam; { /* read a name from the file */ long i; /* an index to the name */ Char c_; /* a character read */ skipstar(thefile); nam->length = 0; do { nam->length++; c_ = getc(thefile->f); if (c_ == '\n') c_ = ' '; nam->letters[nam->length - 1] = c_; } while (!(P_eoln(thefile->f) || nam->length >= namelength || nam->letters[nam->length - 1] == ' ')); if (nam->letters[nam->length - 1] == ' ') nam->length--; if (nam->length < namelength) { for (i = nam->length; i < namelength; i++) nam->letters[i] = ' '; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* brname */ /* end module book.brname version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brline */ Static Void brline(thefile, theline, l) _TEXT *thefile; long *theline; line **l; { /* read a line from the file */ long i = 0; Char acharacter; skipstar(thefile); while (!P_eoln(thefile->f)) { i++; acharacter = getc(thefile->f); if (acharacter == '\n') acharacter = ' '; (*l)->letters[i-1] = acharacter; } (*l)->length = i; (*l)->next = NULL; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* end module book.brline version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brdirect */ Static Void brdirect(thefile, theline, direct) _TEXT *thefile; long *theline; direction *direct; { /* read a direction */ Char ch; skipstar(thefile); fscanf(thefile->f, "%c%*[^\n]", &ch); getc(thefile->f); if (ch == '\n') ch = ' '; (*theline)++; if (ch == '+') *direct = plus; else *direct = minus; } /* end module book.brdirect version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brconfig */ Static Void brconfig(thefile, theline, config) _TEXT *thefile; long *theline; configuration *config; { /* read a configuration */ Char ch; skipstar(thefile); fscanf(thefile->f, "%c%*[^\n]", &ch); getc(thefile->f); if (ch == '\n') ch = ' '; (*theline)++; if (ch == 'l') *config = linear; else *config = circular; } /* end module book.brconfig version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brnotenumber */ Static Void brnotenumber(thefile, theline, note) _TEXT *thefile; long *theline; line **note; { /* book note reading to obtain the number of the object. the procedure returns the value of the number as a global. (this is not such a good practice, but we are stuck with it for now.) */ *note = NULL; numbered = false; number = 0; /* force number to zero if there is no number at all */ /* the next character is n or * depending on whether there are notes */ if (P_peek(thefile->f) != 'n') return; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; if (P_peek(thefile->f) != 'n') { skipstar(thefile); if (!P_eoln(thefile->f)) { if (P_peek(thefile->f) == '#') { numbered = true; getc(thefile->f); /* move past the number symbol */ fscanf(thefile->f, "%ld", &number); } } do { fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } while (P_peek(thefile->f) != 'n'); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; return; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* brnotenumber */ /* end module book.brnotenumber version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brnote */ Static Void brnote(thefile, theline, note) _TEXT *thefile; long *theline; line **note; { /* read note key */ line *newnote; /* the new note */ line *previousnote; /* the last line of the notes */ *note = NULL; if (P_peek(thefile->f) != 'n') /* enter note */ return; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; if (P_peek(thefile->f) != 'n') { /* abort null note (n/n) */ getline(note); newnote = *note; while (P_peek(thefile->f) != 'n') { /* wait until end of note */ brline(thefile, theline, &newnote); previousnote = newnote; /* get next note */ getline(&newnote->next); newnote = newnote->next; } /* last note was not used, so: */ clearline(&newnote); previousnote->next = NULL; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; return; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* brnote */ /* end module book.brnote version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brheader */ Static Void brheader(thefile, theline, hea) _TEXT *thefile; long *theline; header *hea; { /* read the header of a key. */ fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* move past the object name - new definition 1999 Mar 13 */ (*theline)++; /*bbb*/ /* read key name */ brname(thefile, theline, &hea->keynam); /* read full name */ getline(&hea->fulnam); brline(thefile, theline, &hea->fulnam); /* read note key */ if (readnumber) brnotenumber(thefile, theline, &hea->note); else brnote(thefile, theline, &hea->note); } /* end module book.brheader version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.copyheader */ Static Void copyheader(fromhea, tohea) header fromhea, *tohea; { /* copy the header fromhea into tohea. Note that the linked objects are NOT copied, but merely pointed to. */ memcpy(tohea->keynam.letters, fromhea.keynam.letters, sizeof(alpha)); tohea->keynam.length = fromhea.keynam.length; tohea->note = fromhea.note; tohea->fulnam = fromhea.fulnam; } /* end module book.copyheader version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brpiekey */ Static Void brpiekey(thefile, theline, pie) _TEXT *thefile; long *theline; piekey *pie; { /* read piece key, track the line number */ brheader(thefile, theline, &pie->hea); brreanum(thefile, theline, &pie->mapbeg); brconfig(thefile, theline, &pie->coocon); brdirect(thefile, theline, &pie->coodir); brnumber(thefile, theline, &pie->coobeg); brnumber(thefile, theline, &pie->cooend); brconfig(thefile, theline, &pie->piecon); brdirect(thefile, theline, &pie->piedir); brnumber(thefile, theline, &pie->piebeg); brnumber(thefile, theline, &pie->pieend); } /* end module book.brpiekey version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brdna */ Static Void brdna(thefile, theline, dna) _TEXT *thefile; long *theline; dnastring **dna; { /* read in dna from thefile, track the line */ /* note: if the dna were circularized, by linking the last dnastring to the first, then the cleardna routine could not clear properly, and would loop forever... there is no reason to do that, since a simple mod function will allow one to access the circle. */ Char ch; dnastring *workdna; long SET[5]; long TEMP; getdna(dna); workdna = *dna; ch = getto(thefile, theline, P_addset(P_expset(SET, 0L), 'd')); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; ch = getc(thefile->f); /* skipstar */ if (ch == '\n') ch = ' '; while (ch == '*') { ch = getc(thefile->f); /* skip blank */ if (ch == '\n') ch = ' '; do { ch = getc(thefile->f); if (ch == '\n') ch = ' '; if (ch == 't' || ch == 'g' || ch == 'c' || ch == 'a') { if (workdna->length == dnamax) { getdna(&workdna->next); workdna = workdna->next; } workdna->length++; TEMP = workdna->length - 1; P_clrbits_B(workdna->part, TEMP, 1, 3); P_putbits_UB(workdna->part, TEMP, (int)chartobase(ch), 1, 3); } } while (!P_eoln(thefile->f)); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* go to next line */ (*theline)++; ch = getc(thefile->f); /* ch is either '*' or 'd' */ if (ch == '\n') ch = ' '; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* read past the d */ (*theline)++; } /* end module book.brdna version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brpiece */ Static Void brpiece(thefile, theline, pie) _TEXT *thefile; long *theline; piece **pie; { /* read in a piece, change theline to reflect the lines traversed */ /* readln(thefile); (* move past the word 'piece' - new definition 1999 Mar 13 *) theline := succ(theline); (* BUG: was below! *) bbb*/ brpiekey(thefile, theline, &(*pie)->key); if (numbered || !skipunnum) brdna(thefile, theline, &(*pie)->dna); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* move past the word 'piece' - new definition 1999 Mar 13 */ (*theline)++; } /* end module book.brpiece version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.brinit */ Static Void brinit(book, theline) _TEXT *book; long *theline; { /* check that the book is ok to read, and set up the global variables for br routines */ /* halt if the book is bad (first word is 'halt') or the first character is not * */ if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); if (!BUFEOF(book->f)) { /* check for the date line */ if (P_peek(book->f) != '*') { if (P_peek(book->f) != 'h') printf(" this is not the first line of a book:\n"); else printf(" bad book:\n"); putchar(' '); while (!(P_eoln(book->f) | BUFEOF(book->f))) { putchar(P_peek(book->f)); getc(book->f); } putchar('\n'); halt(); } } else { printf(" book is empty\n"); halt(); } /* initialize free storage */ freeline = NULL; freedna = NULL; readnumber = true; /* usually we read in numbers for items */ number = 0; /* arbitrary value */ numbered = false; /* the piece has no number (none yet read in) */ skipunnum = false; *theline = 1; } /* brinit */ /* end module book.brinit version = 7.40; {of delmod.p 2000 Feb 18} */ /* ************************************************************************ */ /* end module package.brpiece version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module book.getpiece */ Static Void getpiece(thefile, theline, pie) _TEXT *thefile; long *theline; piece **pie; { /* move to and read in the next piece in the book */ Char ch; long SET[5]; ch = getto(thefile, theline, P_addset(P_expset(SET, 0L), 'p')); /* get to the next p(iece) in the book */ if (ch != ' ') { brpiece(thefile, theline, pie); /* 1999 june 2: removed this: ch:=getto(thefile,theline,['p']); (* read to end of p *) */ /* bbb - now done in brpiece readln(thefile); (* read past piece *) theline := succ(theline); */ } else clearpiece(pie); } /* end module book.getpiece version = 7.40; {of delmod.p 2000 Feb 18} */ /* ************************************************************************ */ /* end module package.getpiece version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module findblank */ Static Void findblank(afile) _TEXT *afile; { /* read a file to find the next blank character */ Char ch; do { ch = getc(afile->f); if (ch == '\n') ch = ' '; } while (ch != ' '); } /* end module findblank version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module findnonblank */ Static Void findnonblank(afile, ch) _TEXT *afile; Char *ch; { /* find the next non blank character in a file, return it in ch. */ *ch = ' '; while (!BUFEOF(afile->f) && *ch == ' ') { *ch = getc(afile->f); if (*ch == '\n') *ch = ' '; if (P_eoln(afile->f)) { fscanf(afile->f, "%*[^\n]"); getc(afile->f); } } } #define maximumrange 10000 /* if the alignment point is more than this distance from the piece ends, the program halts in an attempt to catch the alignment bug... 1991 Jan 11 It appears that the rewrite of the code has removed the bug, but the check will be kept. */ #define semicolon ';' /* end of delila instruction */ /* Local variables for align: */ struct LOC_align { Char ch; /* a character in inst */ trigger endcomment; /* trigger to find '*-)' (ignore the dash!) */ trigger endcurly; /* trigger to find comments: '}' */ } ; /* procedure rd(var f: text; var ch: char); (* read ch from f allowing inspection of the result *) begin read(f,ch); write(output,ch); write(list,ch); write(output,'<',ch,'>'); end; procedure rdln(var f: text); (* readln f allowing inspection of the result *) begin readln(f); writeln(output); writeln(list); end; */ Local Void skipcomment(f, LINK) _TEXT *f; struct LOC_align *LINK; { /* skip an entire comment */ boolean comment = true; /* true means we are inside a comment */ /* skip to end of comment */ resettrigger(&LINK->endcomment); while (comment) { if (BUFEOF(f->f)) { printf("A comment does not end!\n"); halt(); } if (P_eoln(f->f)) { fscanf(f->f, "%*[^\n]"); getc(f->f); continue; } /* rdln(f) */ LINK->ch = getc(f->f); if (LINK->ch == '\n') LINK->ch = ' '; testfortrigger(LINK->ch, &LINK->endcomment); if (LINK->endcomment.found) { comment = false; /*write(output,'<'); rd(f,ch); write(output,'>');*/ } } } Local Void skipcurly(f, LINK) _TEXT *f; struct LOC_align *LINK; { /* skip an entire comment made by {}*/ boolean comment = true; /* true means we are inside a comment */ /* skip to end of comment */ resettrigger(&LINK->endcurly); while (comment) { if (BUFEOF(f->f)) { printf("A comment does not end!\n"); halt(); } if (P_eoln(f->f)) { fscanf(f->f, "%*[^\n]"); getc(f->f); continue; } /* rdln(f) */ LINK->ch = getc(f->f); if (LINK->ch == '\n') LINK->ch = ' '; testfortrigger(LINK->ch, &LINK->endcurly); if (LINK->endcurly.found) { comment = false; /*write(output,'<'); rd(f,ch); write(output,'>');*/ } } } /* end module findnonblank version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module align.align */ Static Void align(inst, book, theline, pie, length, alignedbase) _TEXT *inst, *book; long *theline; piece **pie; long *length, *alignedbase; { /* documentation on align is in module info.align and delman.use.aligned.books. 1996 Sep 12: The routine now uses the trigger functions found in prgmod. The bug in the oldalign routine (that it misses the end of comments that end in a series of astrisks) has been fixed. It now checks that the piece corresponds to the book. */ struct LOC_align V; long p; /* index to a piece name */ long p1; /* another index to a piece name */ boolean done = false; /* done finding an aligning get */ long thebase; /* the base read in */ boolean indefault = false; /* true when within a default statement. These can contain the word 'piece', which must be ignored. */ trigger defaulttrigger; /* trigger to find 'default' */ trigger gettrigger; /* trigger to find 'get' */ trigger piecetrigger; /* trigger to find 'piece' */ trigger begincomment; /* trigger to find '(-*' (ignore the dash!) */ trigger begincurly; /* trigger to find comments: '{' */ name *WITH; long FORLIM; filltrigger(&gettrigger, "get "); filltrigger(&piecetrigger, "piece "); filltrigger(&defaulttrigger, "default "); filltrigger(&begincomment, "(* "); filltrigger(&V.endcomment, "*) "); filltrigger(&begincurly, "{ "); filltrigger(&V.endcurly, "} "); resettrigger(&gettrigger); resettrigger(&piecetrigger); resettrigger(&defaulttrigger); resettrigger(&begincomment); resettrigger(&begincurly); if (BUFEOF(book->f)) /* if there is still more to the book ... */ return; getpiece(book, theline, pie); /* read in the piece */ if (BUFEOF(book->f)) /* if we found a piece ... */ return; *length = pietoint((*pie)->key.pieend, *pie); /* calculate piece length */ /* now find in inst the next occurance of 'get' */ while (!done) { if (BUFEOF(inst->f)) { /* no instructions? */ *alignedbase = 1; /* simply align by the first base */ done = true; break; } if (P_eoln(inst->f)) { fscanf(inst->f, "%*[^\n]"); getc(inst->f); continue; } /*then rdln(inst)*/ V.ch = getc(inst->f); if (V.ch == '\n') V.ch = ' '; testfortrigger(V.ch, &begincomment); testfortrigger(V.ch, &begincurly); if (begincomment.found || begincurly.found) { if (V.ch == '*') { skipcomment(inst, &V); resettrigger(&begincomment); } else { resettrigger(&begincurly); skipcurly(inst, &V); } continue; } testfortrigger(V.ch, &gettrigger); if (gettrigger.found) { findnonblank(inst, &V.ch); /* get to "from" */ findblank(inst); /* get past "from" */ fscanf(inst->f, "%ld", &thebase); /* read in the alignedbase */ /*writeln(output);writeln(output,'thebase = ',thebase:1);*/ *alignedbase = pietoint(thebase, *pie); /*writeln(output,'alignedbase=',alignedbase:1);*/ done = true; } testfortrigger(V.ch, &defaulttrigger); if (defaulttrigger.found) { indefault = true; resettrigger(&defaulttrigger); } if (V.ch == semicolon) indefault = false; /* check that piece names are correct */ testfortrigger(V.ch, &piecetrigger); if (indefault) continue; if (!piecetrigger.found) continue; skipblanks(inst); /* get to name */ WITH = &(*pie)->key.hea.keynam; FORLIM = WITH->length; for (p = 1; p <= FORLIM; p++) { V.ch = getc(inst->f); if (V.ch == '\n') V.ch = ' '; if (WITH->letters[p-1] != V.ch) { printf("Piece name in book: \n"); /* p2c: patlrn.p, line 1348: Note: * Format for packed-array-of-char will work only if width < length [321] */ printf("%.*s\n", WITH->length, WITH->letters); printf("does not match the inst file name:\n"); /* write the letters that matched: */ for (p1 = 1; p1 < p; p1++) putchar(WITH->letters[p-1]); /* write the offending letter: */ putchar(V.ch); /* get the rest of the name and show it: */ done = P_eoln(inst->f); while (!done) { done = P_eoln(inst->f); if (done) break; V.ch = getc(inst->f); if (V.ch == '\n') V.ch = ' '; if (V.ch == ' ' || V.ch == ';') done = true; if (!done) putchar(V.ch); } putchar('\n'); /* mark the first letter that does not match: */ for (p1 = 1; p1 < p; p1++) putchar(' '); printf("^\n"); halt(); } } } /*rd(inst,ch);*/ if (*alignedbase > -maximumrange && *alignedbase <= *length + maximumrange) return; printf(" In procedure align:\n"); printf(" read in base was %ld\n", thebase); printf(" in internal coordinates: %ld\n", *alignedbase); printf(" maximum range was %ld\n", (long)maximumrange); printf(" piece length was %ld\n", *length); WITH = &(*pie)->key.hea.keynam; /* p2c: patlrn.p, line 1389: Note: * Format for packed-array-of-char will work only if width < length [321] */ printf(" piece name: %.*s\n", WITH->length, WITH->letters); printf(" piece number: %ld\n", number); printf(" aligned base is too far away... see the code\n"); halt(); } #undef maximumrange #undef semicolon /* end module align.align version = 7.40; {of delmod.p 2000 Feb 18} */ /* ************************************************************************ */ /* end module package.align version = 7.40; {of delmod.p 2000 Feb 18} */ /* begin module package.datetime */ /* ************************************************************************ */ /* 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 readdatetime */ Static Void readdatetime(thefile, adatetime) _TEXT *thefile; Char *adatetime; { /* read the date and time from the file */ long index; /* to the udatetime */ /* the following is an unpacked date time array, to avoid reading into a packed array. reading into a packed array is not transportable */ Char udatetime[datetimearraylength]; for (index = 0; index < datetimearraylength; index++) { udatetime[index] = getc(thefile->f); if (udatetime[index] == '\n') udatetime[index] = ' '; } memcpy(adatetime, udatetime, sizeof(datetimearray)); if (adatetime[2] == '/' && adatetime[11] == ':') printf(" old datetime (only 2 year digits) read: %.*s\n", datetimearraylength, adatetime); /* p2c: patlrn.p, line 1478: Note: * Format for packed-array-of-char will work only if width < length [321] */ /* if (adatetime[3]<>'/') or (adatetime[12]<>':') then begin writeln(output,' bad date time read: ',adatetime:1); halt end; for index:=18 to datetimearraylength do adatetime[index]:=' ' */ } /* end module readdatetime 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 timeseed */ Static Void addtoseed(seed, power, c_) double *seed, *power; Char c_; { /* add the digit represented by c to the seed at the power position */ long n; /* the character represented by c */ *power /= 10; /* writeln(output,'addtoseed, c = ',c); writeln(output,'addtoseed, ord(c) = ',ord(c)); */ switch (c_) { case ' ': printf("timeseed: error in datetime\n"); halt(); break; case '0': n = 0; break; case '1': n = 1; break; case '2': n = 2; break; case '3': n = 3; break; case '4': n = 4; break; case '5': n = 5; break; case '6': n = 6; break; case '7': n = 7; break; case '8': n = 8; break; case '9': n = 9; break; } /*writeln(output,'timeseed number is [',n:1,']'); (@ debug */ *seed += *power * n; } /* addtoseed */ Static Void makeseed(adatetime, seed) Char *adatetime; double *seed; { /* convert adatetime to a real number in seed, reversed order */ double power = 1.0; /* a digit of the seed such as 0.01 */ *seed = 0.0; addtoseed(seed, &power, adatetime[18]); addtoseed(seed, &power, adatetime[17]); /* : */ addtoseed(seed, &power, adatetime[15]); addtoseed(seed, &power, adatetime[14]); /* : */ addtoseed(seed, &power, adatetime[12]); addtoseed(seed, &power, adatetime[11]); /* */ addtoseed(seed, &power, adatetime[9]); addtoseed(seed, &power, adatetime[8]); /* / */ addtoseed(seed, &power, adatetime[6]); addtoseed(seed, &power, adatetime[5]); /* / */ addtoseed(seed, &power, adatetime[3]); addtoseed(seed, &power, adatetime[2]); } Static Void orderseed(adatetime, seed) Char *adatetime; double *seed; { /* convert adatetime to a real number in seed, normal order */ double power = 1.0; /* a digit of the seed such as 0.01 */ *seed = 0.0; addtoseed(seed, &power, adatetime[2]); addtoseed(seed, &power, adatetime[3]); addtoseed(seed, &power, adatetime[5]); addtoseed(seed, &power, adatetime[6]); /* / */ addtoseed(seed, &power, adatetime[8]); addtoseed(seed, &power, adatetime[9]); /* / */ addtoseed(seed, &power, adatetime[11]); addtoseed(seed, &power, adatetime[12]); /* */ addtoseed(seed, &power, adatetime[14]); addtoseed(seed, &power, adatetime[15]); /* : */ addtoseed(seed, &power, adatetime[17]); addtoseed(seed, &power, adatetime[18]); } Static Void timeseed(seed) double *seed; { /* read the computer date and time. reverse the order of the digits and put a decimal point in front. this gives a fraction between zero and one that varies quite quickly, and is always unique (if the computer has sufficient accuracy). it is to be used as a seed to a random number generator. */ datetimearray adatetime; /* a date and time */ getdatetime(adatetime); /* writeln(output,'timeseed: adatetime: ',adatetime); */ makeseed(adatetime, seed); } /* timeseed */ /* end module timeseed version = 'cdatemod.p 1.19 1999Dec13'; */ /* begin module limitdate */ Static Void limitdate(a_, b, c_, d, limitdatetime_) Char a_, b, c_, d; Char *limitdatetime_; { /* test whether the current time is before the limit. If it is later, halt the program */ datetimearray limitdatetime, adatetime; /* a date and time */ double Dday; /* the critical day */ double now; /* this very moment */ memcpy(limitdatetime, limitdatetime_, sizeof(datetimearray)); getdatetime(adatetime); orderseed(adatetime, &now); if (limitdatetime[0] != ' ' || limitdatetime[1] != ' ' || limitdatetime[2] != ' ' || limitdatetime[3] != ' ') halt(); limitdatetime[0] = a_; limitdatetime[1] = b; limitdatetime[2] = c_; limitdatetime[3] = d; orderseed(limitdatetime, &Dday); /* writeln(output,'now: ',now:20:8); writeln(output,'Dday: ',Dday:20:8); */ if (now > Dday) { /* writeln(output,'This program expired on ',limitdatetime); leave no clues */ halt(); } } /* end module limitdate version = 'cdatemod.p 1.19 1999Dec13'; */ /* ************************************************************************ */ /* end module package.datetime version = 'cdatemod.p 1.19 1999Dec13'; */ Static base getalbase(position, pie) long position; alpiece *pie; { /* get a base from the nth position (internal coordinates) of the piece. no protection is made against positions outside the piece. this procedure does the same thing as the standard getbase procedure from delmods, except that it uses for the variable 'pie' one of type alpieceptr instead of one of type pieceptr. the program could be changed to the more standard procedure, and it probably will be ... */ dnastring *workdna; long p = dnamax; /* the last base of the dna part */ workdna = pie->dna; while (position > p) { p += dnamax; workdna = workdna->next; } return ((base)P_getbits_UB(workdna->part, position - p + dnamax - 1, 1, 3)); } #define learnmax 16 /* the size of learnend */ /* begin module matrix.readmatrix */ Static Void findlearnend(pattern) _TEXT *pattern; { /* locate the end of the cyclic learning part of the pattern file */ /* this array contains the pattern that defines the end */ Char learnend[learnmax]; long state_ = 1; /* how close we are to finding learnend */ if (*pattern->name != '\0') { if (pattern->f != NULL) pattern->f = freopen(pattern->name, "r", pattern->f); else pattern->f = fopen(pattern->name, "r"); } else rewind(pattern->f); if (pattern->f == NULL) _EscIO2(FileNotFound, pattern->name); RESETBUF(pattern->f, Char); memcpy(learnend, "end of learning.", (long)learnmax); while (!BUFEOF(pattern->f) && state_ < learnmax) { if (learnend[state_-1] == P_peek(pattern->f)) state_++; else state_ = 1; if (P_eoln(pattern->f)) { fscanf(pattern->f, "%*[^\n]"); getc(pattern->f); } else getc(pattern->f); } if (!BUFEOF(pattern->f)) return; printf("pattern matrix does not contain \""); printf("%.*s\" signal\n", learnmax, learnend); halt(); } /* findlearnend */ #undef learnmax Static Void getcolon(f) _TEXT *f; { /* move to the next colon in file f */ while (P_peek(f->f) != ':') { getc(f->f); if (BUFEOF(f->f)) { printf("pattern is missing colons\n"); halt(); } } getc(f->f); /* move past the colon */ } /* getcolon */ Static Void readmatrix(thefile, wmatrix, beginning, width) _TEXT *thefile; long (*wmatrix)[maxmatrix]; long *beginning, *width; { /* read a pattern matrix wmatrix from the file thefile, returning the aligned position for the first position (beginning) and the width */ long i; /* an index */ base ba; /* an index */ long FORLIM; findlearnend(thefile); /* skip min and max values */ getcolon(thefile); getcolon(thefile); getcolon(thefile); /* skip to range */ fscanf(thefile->f, "%ld", beginning); /* read first position of the matrix */ getcolon(thefile); /* skip to width */ fscanf(thefile->f, "%ld", width); /* read width of the matrix */ if (*width > maxmatrix) { printf("input matrix too large\n"); halt(); } FORLIM = *width; for (i = 0; i < FORLIM; i++) { /* read in matrix */ getcolon(thefile); /* skip position label */ for (ba = a; (long)ba <= (long)t; ba = (base)((long)ba + 1)) fscanf(thefile->f, "%ld", &wmatrix[(long)ba][i]); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); } /* set all the unused elements of wmatrix to 0 */ for (i = *width; i < maxmatrix; i++) { for (ba = a; (long)ba <= (long)t; ba = (base)((long)ba + 1)) wmatrix[(long)ba][i] = 0; } } /* readmatrix */ /* end module matrix.readmatrix version = 'auxmod 1.40 94 Sep 5 gds/tds'; */ Static Void initialize() { /* initializes all variables, including wmatrix */ base ba; long beginning = 0; /* of the starting matrix */ long i; printf("patlrn %4.2f\n", version); brinit(&funcbook, &theline); brinit(&nfuncbook, &theline); if (*funcinst.name != '\0') { if (funcinst.f != NULL) funcinst.f = freopen(funcinst.name, "r", funcinst.f); else funcinst.f = fopen(funcinst.name, "r"); } else rewind(funcinst.f); if (funcinst.f == NULL) _EscIO2(FileNotFound, funcinst.name); RESETBUF(funcinst.f, Char); if (*nfuncinst.name != '\0') { if (nfuncinst.f != NULL) nfuncinst.f = freopen(nfuncinst.name, "r", nfuncinst.f); else nfuncinst.f = fopen(nfuncinst.name, "r"); } else rewind(nfuncinst.f); if (nfuncinst.f == NULL) _EscIO2(FileNotFound, nfuncinst.name); RESETBUF(nfuncinst.f, Char); if (*minmax.name != '\0') { if (minmax.f != NULL) minmax.f = freopen(minmax.name, "r", minmax.f); else minmax.f = fopen(minmax.name, "r"); } else rewind(minmax.f); if (minmax.f == NULL) _EscIO2(FileNotFound, minmax.name); RESETBUF(minmax.f, Char); if (*start.name != '\0') { if (start.f != NULL) start.f = freopen(start.name, "r", start.f); else start.f = fopen(start.name, "r"); } else rewind(start.f); if (start.f == NULL) _EscIO2(FileNotFound, start.name); RESETBUF(start.f, Char); if (*pattern.name != '\0') { if (pattern.f != NULL) pattern.f = freopen(pattern.name, "w", pattern.f); else pattern.f = fopen(pattern.name, "w"); } else { if (pattern.f != NULL) rewind(pattern.f); else pattern.f = tmpfile(); } if (pattern.f == NULL) _EscIO2(FileNotFound, pattern.name); SETUPBUF(pattern.f, Char); functional = true; /* these are constants */ nonfunctional = false; maxafter = 0; first[functional] = NULL; first[nonfunctional] = NULL; changes = 0; timesthru = 0; done = false; /* wmatirx initialization */ if (!BUFEOF(start.f)) readmatrix(&start, wmatrix, &beginning, &width); else { for (ba = a; (long)ba <= (long)t; ba = (base)((long)ba + 1)) { for (i = 0; i < maxmatrix; i++) wmatrix[(long)ba][i] = 0; } } apiece = (piece *)Malloc(sizeof(piece)); maxaligned = 1 - beginning; } Static Void patheader() { /* write the pattern header to file pattern */ fprintf(pattern.f, " patlrn %4.2f pattern learning program\n", version); getdatetime(adatetime); putc(' ', pattern.f); writedatetime(&pattern, adatetime); fprintf(pattern.f, "\n functional sequences are from:\n"); putc(' ', pattern.f); copyaline(&funcbook, &pattern); fprintf(pattern.f, " nonfunctional sequences are from:\n"); putc(' ', pattern.f); copyaline(&nfuncbook, &pattern); putc('\n', pattern.f); if (*start.name != '\0') { if (start.f != NULL) start.f = freopen(start.name, "r", start.f); else start.f = fopen(start.name, "r"); } else rewind(start.f); if (start.f == NULL) _EscIO2(FileNotFound, start.name); RESETBUF(start.f, Char); if (!BUFEOF(start.f)) { fscanf(start.f, "%*[^\n]"); getc(start.f); fprintf(pattern.f, " matrix initialized as "); copyaline(&start, &pattern); } else fprintf(pattern.f, " matrix initialized as all 0's\n"); putc('\n', pattern.f); } Static Void setparam() { /* read from file 'patlrnp' the value of 'maxtimes', the number of times through the sequences before stopping without a solution */ if (*patlrnp.name != '\0') { if (patlrnp.f != NULL) patlrnp.f = freopen(patlrnp.name, "r", patlrnp.f); else patlrnp.f = fopen(patlrnp.name, "r"); } else rewind(patlrnp.f); if (patlrnp.f == NULL) _EscIO2(FileNotFound, patlrnp.name); RESETBUF(patlrnp.f, Char); if (!BUFEOF(patlrnp.f)) { fscanf(patlrnp.f, "%ld%*[^\n]", &maxtimes); getc(patlrnp.f); } else maxtimes = 100; } Static Void readignore() { /* this reads from the input ignore the regions which are not to be considered in the pattern leaarning. the format of the ignore file is two integers per line, up to maxignore lines, where the first integer is the beginning of the region to be ignored and the second is the end (relative to the aligned base). the last can be equal to the first but not less than it. */ long index; /* the number of regions to be ignored */ if (*ignore.name != '\0') { if (ignore.f != NULL) ignore.f = freopen(ignore.name, "r", ignore.f); else ignore.f = fopen(ignore.name, "r"); } else rewind(ignore.f); if (ignore.f == NULL) _EscIO2(FileNotFound, ignore.name); RESETBUF(ignore.f, Char); for (index = 0; index < maxignore; index++) ignorebases[(long)fiveprime][index] = -10000; index = 1; if (!BUFEOF(ignore.f)) fprintf(pattern.f, " the following regions are ignored by setting wmatrix to 0 :\n"); while (!BUFEOF(ignore.f) && index <= maxignore) { fscanf(ignore.f, "%ld", &ignorebases[(long)fiveprime][index-1]); fscanf(ignore.f, "%ld%*[^\n]", &ignorebases[(long)threeprime][index-1]); getc(ignore.f); if (ignorebases[(long)fiveprime][index-1] > ignorebases[(long)threeprime] [index-1]) { printf(" ignore file format error - fiveprime greater than threeprime\n"); halt(); } fprintf(pattern.f, "%6ld to %12ld\n", ignorebases[(long)fiveprime] [index-1], ignorebases[(long)threeprime][index-1]); index++; } if ((index > maxignore) & (!BUFEOF(ignore.f))) { printf( " ignore file has too many lines; increase the constant \"maxignore\" and recompile\n"); halt(); } fprintf(pattern.f, " \n"); } Static Void ignoring() { /* sets the regions specified by the file ignore to zero in wmatrix */ long i; long index = 1; base ba; long FORLIM; while (ignorebases[(long)fiveprime][index-1] != -10000 && index <= maxignore) { FORLIM = ignorebases[(long)threeprime][index-1]; for (i = ignorebases[(long)fiveprime][index-1] - 1; i < FORLIM; i++) { for (ba = a; (long)ba <= (long)t; ba = (base)((long)ba + 1)) wmatrix[(long)ba][maxaligned + i] = 0; } index++; } } /* Local variables for makealignedpieces: */ struct LOC_makealignedpieces { long seqnumb[2]; } ; /* Local variables for alignedpiece: */ struct LOC_alignedpiece { struct LOC_makealignedpieces *LINK; alpiece *alpie; } ; Local Void matrixwidth(LINK) struct LOC_alignedpiece *LINK; { /* this determines maxaligned and maxafter, which determine the pattern width */ if (maxaligned < LINK->alpie->alignedbase) maxaligned = LINK->alpie->alignedbase; if (maxafter < LINK->alpie->length - LINK->alpie->alignedbase) maxafter = LINK->alpie->length - LINK->alpie->alignedbase; if (maxaligned + maxafter > maxmatrix) { printf("constant maxmatrix is too small"); halt(); } } Local Void alignedpiece(alpie_, book, inst, LINK) alpiece *alpie_; _TEXT *book, *inst; struct LOC_makealignedpieces *LINK; { struct LOC_alignedpiece V; V.LINK = LINK; V.alpie = alpie_; LINK->seqnumb[seqclass] = 0; while (!BUFEOF(book->f)) { V.alpie = (alpiece *)Malloc(sizeof(alpiece)); align(inst, book, &theline, &apiece, &V.alpie->length, &V.alpie->alignedbase); if (BUFEOF(book->f)) break; LINK->seqnumb[seqclass]++; V.alpie->dna = apiece->dna; apiece->dna = NULL; V.alpie->next = first[seqclass]; first[seqclass] = V.alpie; clearpiece(&apiece); matrixwidth(&V); } } Static Void makealignedpieces() { /* we make a linked list of the functional sequences and their alignments, and then do the same for the nonfunctional sequences. the maximum sequence length is determined by procedure matrixwidth */ /* funcmin and nfuncmax vary with changes to wmatrix (increasing or decreasing as wmatrix is added to or subtracted from) or they can be set by the file minmax, which has two integers, the first for funcmin and the second for nfuncmax. */ struct LOC_makealignedpieces V; seqclass = functional; alignedpiece(funcpie, &funcbook, &funcinst, &V); seqclass = nonfunctional; alignedpiece(nfuncpie, &nfuncbook, &nfuncinst, &V); if (V.seqnumb[functional] > V.seqnumb[nonfunctional]) mostseqs = functional; else mostseqs = nonfunctional; width = maxaligned + maxafter; if (BUFEOF(minmax.f)) { funcmin = 0; nfuncmax = -1; varthresh = true; return; } fscanf(minmax.f, "%ld", &funcmin); fscanf(minmax.f, "%ld", &nfuncmax); varthresh = false; } /* Local variables for evaluatew: */ struct LOC_evaluatew { alpiece *thispie; } ; Local Void arewedone() { /* we are done if (1) the sequence list we just came to the end of (seqclass) is the longest list (mostseqs) and (2) the number of changes is equal to 0 or we have been through all the sequences the maximum allowed times (maxtimes) */ if (mostseqs != seqclass) return; fprintf(pattern.f, "%8ld\n", changes); if (changes == 0 || timesthru == maxtimes) done = true; else { changes = 0; timesthru++; } if (changes != 0) fprintf(pattern.f, " maximum allowed times through sequences : %2ld\n", timesthru); } Local Void chooseseq(LINK) struct LOC_evaluatew *LINK; { if (seqclass == functional) { LINK->thispie = funcpie; if (LINK->thispie != NULL) { funcpie = funcpie->next; return; } arewedone(); if (!done) { funcpie = first[functional]; LINK->thispie = funcpie; } return; } LINK->thispie = nfuncpie; if (LINK->thispie != NULL) { nfuncpie = nfuncpie->next; return; } arewedone(); if (!done) { nfuncpie = first[nonfunctional]; LINK->thispie = nfuncpie; } } Local Void evaluate(LINK) struct LOC_evaluatew *LINK; { /* wmatrix is evaluated as follows: the corresponding elements of seqmatrix and wmatrix are multiplied and all the resulting products are summed to give 'valu'. if the sequence is functional and valu is < funcmin, wmatrix is changed by adding seqmatrix to it. if the sequence is nonfunctional and valu is > nfuncmax, wmatrix is changed by subtracting seqmatrix from it. after each test of wmatrix by a sequence, a sequence of the other class is chosen to test it next and we repeat this until done = true. */ long missing; /* the number fewer bases preceding the aligned base in this sequence than in the maximum */ long valu = 0; /* variable ba is neither used nor set ba : base; */ long i, FORLIM; missing = maxaligned - LINK->thispie->alignedbase; FORLIM = LINK->thispie->length; for (i = 1; i <= FORLIM; i++) valu += wmatrix[(long)getalbase(i, LINK->thispie)][missing + i - 1]; if (seqclass == functional && valu < funcmin) { changes++; FORLIM = LINK->thispie->length; for (i = 1; i <= FORLIM; i++) wmatrix[(long)getalbase(i, LINK->thispie)][missing + i - 1]++; if (varthresh) { funcmin--; nfuncmax--; } ignoring(); } if (seqclass == nonfunctional && valu > nfuncmax) { changes++; FORLIM = LINK->thispie->length; for (i = 1; i <= FORLIM; i++) wmatrix[(long)getalbase(i, LINK->thispie)][missing + i - 1]--; if (varthresh) { funcmin++; nfuncmax++; } ignoring(); } seqclass = !seqclass; } Static Void evaluatew() { /* this chooses a sequence and evaluates it by wmatrix. if the required condition (given by funcmin and nfuncmax) is not met wmatrix is changed accordingly */ struct LOC_evaluatew V; chooseseq(&V); if (!done) evaluate(&V); } Static Void printoutw() { /* print out the w matrix to the pattern file */ base ba; long i, FORLIM; fprintf(pattern.f, " end of learning.\n\n"); fprintf(pattern.f, " minimum value for a functional sequence is: %ld\n", funcmin); fprintf(pattern.f, " maximum value for a nonfunctional sequence is: %ld\n\n", nfuncmax); fprintf(pattern.f, " range: %ld to %ld", 1 - maxaligned, width - maxaligned); fprintf(pattern.f, " width: %ld\n\n", width); /* write the matrix vertically to avoid being too wide to transport */ /* label the columns */ fprintf(pattern.f, " pos. %5c%5c%5c%5c\n", 'a', 'c', 'g', 't'); /* make the upper matrix-border */ fprintf(pattern.f, "%6c", ' '); for (i = 1; i <= 23; i++) putc('-', pattern.f); putc('\n', pattern.f); FORLIM = width; /* write the matrix positions and elements */ for (i = 1; i <= FORLIM; i++) { fprintf(pattern.f, " %4ld :", i - maxaligned); for (ba = a; (long)ba <= (long)t; ba = (base)((long)ba + 1)) fprintf(pattern.f, " %4ld", wmatrix[(long)ba][i-1]); fprintf(pattern.f, " :\n"); } /* make the lower matrix-border */ fprintf(pattern.f, "%6c", ' '); for (i = 1; i <= 23; i++) putc('-', pattern.f); putc('\n', pattern.f); } /* printoutw */ main(argc, argv) int argc; Char *argv[]; { PASCAL_MAIN(argc, argv); if (setjmp(_JL1)) goto _L1; nfuncinst.f = NULL; strcpy(nfuncinst.name, "nfuncinst"); funcinst.f = NULL; strcpy(funcinst.name, "funcinst"); nfuncbook.f = NULL; strcpy(nfuncbook.name, "nfuncbook"); funcbook.f = NULL; strcpy(funcbook.name, "funcbook"); start.f = NULL; strcpy(start.name, "start"); minmax.f = NULL; strcpy(minmax.name, "minmax"); ignore.f = NULL; strcpy(ignore.name, "ignore"); pattern.f = NULL; strcpy(pattern.name, "pattern"); patlrnp.f = NULL; strcpy(patlrnp.name, "patlrnp"); initialize(); setparam(); patheader(); readignore(); fprintf(pattern.f, " the number of changes to wmatrix in each round\n"); makealignedpieces(); funcpie = first[functional]; nfuncpie = first[nonfunctional]; seqclass = mostseqs; /* we begin with a sequence from the most abundant class */ while (!done) evaluatew(); printoutw(); _L1: if (patlrnp.f != NULL) fclose(patlrnp.f); if (pattern.f != NULL) fclose(pattern.f); if (ignore.f != NULL) fclose(ignore.f); if (minmax.f != NULL) fclose(minmax.f); if (start.f != NULL) fclose(start.f); if (funcbook.f != NULL) fclose(funcbook.f); if (nfuncbook.f != NULL) fclose(nfuncbook.f); if (funcinst.f != NULL) fclose(funcinst.f); if (nfuncinst.f != NULL) fclose(nfuncinst.f); exit(EXIT_SUCCESS); } /* patlrn */ /* End. */