program frese(fresep, sequ, output);
(* frese: frequency table to sequ

  Tom Schneider
  NCI/FCRDC Bldg 469. Room 144
  P.O. Box B
  Frederick, MD  21702-1201
  (301) 846-5581 (-5532 for messages)
  network address: toms@ncifcrf.gov

  National Cancer Institute
  Laboratory of Mathematical Biology

  1991
 *)

label 1; (* end of program *)

const
(* begin module version *)
version = 1.01; (* of frese.p 1991 November 30
origin 1987 sep 21 *)
(* end module version *)

(* begin module describe.frese *)
(*
name
   frese: frequency table to sequ

synopsis
   frese(fresep: in, sequ: out, output: out)

files
   fresep: input frequency table (parameters to the program)
     a set of integers, 5 per line, representing first the coordinate
     and then the numbers of a,c,g and t to use.
   sequ: sequences which could have produced the fresep frequencies,
     ready for input to makebk.
   output: messages to the user

description
   Frese converts a table of frequencies to a set of raw 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
   makebk.p

author
   Thomas Dana Schneider

bugs

technical notes

*)
(* end module describe.frese *)

(* begin module frese.const *)
   maxarray = 100; (* largest possible array that can be stored *)
(* end module frese.const *)

var
   fresep, sequ: text; (* files used by this program *)

(* begin module halt *)
procedure 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. *)
begin
      writeln(output,' program halt.');
      goto 1
end;
(* end module halt version = 'delmod 6.16 84 mar 12 tds/gds'; *)

(* begin module frese.themain *)
procedure themain(var fresep, sequ: text);
(* the main procedure of the program *)
var
   a,c,g,t: integer; (* numbers of bases *)
   l: integer; (* given coordinate *)
   n: integer; (* count of the sequences produced *)
   newtotal: integer; (* the current total value of a,c,g,t *)
   oldtotal: integer; (* the previous total value of a,c,g,t *)
   p: integer; (* coordinate for storage in this program *)
   q: integer; (* position across the table *)
   spat: boolean; (* have we spat out a base? *)
   store: array[1..maxarray,0..4] of integer; (* for storing the table *)
begin
   writeln(output,'frese ',version:4:2);

   reset(fresep);
   p := 0;
   oldtotal := 0;
   while not eof(fresep) do begin
      readln(fresep,l,a,c,g,t);
      p := p + 1;
      if p > maxarray then begin
         writeln(output,'the table is too wide, increase constant maxarry');
         halt
      end;
      store[p,0] := l;
      store[p,1] := a;
      store[p,2] := c;
      store[p,3] := g;
      store[p,4] := t;
      newtotal := a+c+g+t;
      if newtotal <> oldtotal
      then if oldtotal <> 0 then begin
         writeln(output,'at position ',l:1,' the ',p:1,' position in the',
                        ' table, the total is ',newtotal:1);
         writeln(output,'at the previous position',
                        ' the total was ',oldtotal:1);
         writeln(output,'This program only works for constant numbers at',
                        ' each position.  sorry... ');
         halt
      end;
      oldtotal := newtotal;
   end;

   writeln(output,'total number of sequences to make: ',newtotal:1);

   rewrite(sequ);

(*
   for testing, output should be similar to fresep:
   for l := 1 to p do begin
     for q := 0 to 4 do write(output,store[l,q]:4);
     writeln(output);
   end;
*)

   for n := 1 to newtotal do begin (* create the total number of sequences *)
(*
     write(sequ,'n= ',n:3,' ');
*)
     for l := 1 to p do begin (* create one sequence *)
        q := 1;
        spat := false;
        while not spat do begin
           if store[l,q] > 0
           then begin
              case q of
                 1: write(sequ,'a');
                 2: write(sequ,'c');
                 3: write(sequ,'g');
                 4: write(sequ,'t');
              end;
              store[l,q] := store[l,q] - 1;
              spat := true
           end
           else begin
(*writeln(sequ,'q=',q:1);*)
              q := q + 1;
              if q > 4 then q := 1;
           end
        end
     end;
     writeln(sequ,'.');
   end;
end;
(* end module frese.themain *)

begin
   themain(fresep, sequ);
1: end.