program cutoff(data, cutoffp, datacut, output);
(* cutoff: cutoff scan data

  Dr. Thomas D. Schneider
  National Cancer Institute
  Laboratory of Experimental and Computational Biology
  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.lecb.ncifcrf.gov/~toms/

 *)

label 1; (* end of program *)

const
(* begin module version *)
   version = 1.03; (* of cutoff.p 2004 Nov  5
2004 Nov  5, 1.03: string names
2004 Nov  5, 1.02: functioning!
2004 Nov  5, 1.01: beginning to function
2004 Nov  5, 1.00: origin
*)
updateversion = 1.00; (* defines lowest acceptable current parameter file *)
(* end module version *)

(* begin module describe.cutoff *)
(*
name
   cutoff: cutoff scan data

synopsis
   cutoff(data: in, cutoffp: in, datacut: out, output: out)

files

   data:  output of the scan file

   datacut:  scan file cutoff

   cutoffp:  parameters to control the program.  The file must contain the
      following parameters, one per line:

      parameterversion: The version number of the program.  This allows the
         user to be warned if an old parameter file is used.

description

   Make a higher cutoff of a scan data file.

examples

documentation

see also

   {The scan program that produces the data file is:} scan.p

author

   Thomas Dana Schneider

bugs

technical notes

*)
(* end module describe.cutoff *)

(* begin module info.const *)
   infofield = 10; (* size of field for printing information in bits *)
   infodecim = 6; (* number of decimal places for printing information *)
       (* these are used for conlist only *)
   nfield = 8; (* size of field for printing n, the number of sites *)
(* end module info.const version = 4.86; (@ of prgmod.p 2004 Sep 8 *)

(* begin module interact.const *)
   maxstring = 200;
(* end module interact.const *)

type

(* begin module interact.type *)
(* begin module string.type *)
   stringptr = ^string; (* pointer to a string *)
   string = record (* a string of characters *)
      letters: array[1..maxstring] of char; (* the letters in the string *)
      length: integer; (* the number of characters in the string *)
      current: integer; (* the letter we are working on *)
      next: stringptr; (* the next string in a series *)
   end;
(* end module string.type version = 4.59; (@ of prgmod.p 2003 Jul 31 *)
(* end module interact.type version = 4.59; (@ of prgmod.p 2003 Jul 31 *)

var
   data, (* file used by this program *)
   cutoffp, (* file used by this program *)
   datacut: text; (* file 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 = 4.86; (@ of prgmod.p 2004 Sep 8 *)

(* begin module copyline *)
procedure copyline(var fin, fout: text);
(* copy a line from file fin to file fout
but DO NOT CARRIAGE RETURN on the fout.
Carriage return on the fin. *)
begin (* copyline *)
      while not eoln(fin) do begin
         fout^ := fin^;
         put(fout);
         get(fin)
      end;
      readln(fin);
end; (* copyline *)
(* end module copyline version = 4.86; (@ of prgmod.p 2004 Sep 8 *)

(* begin module skipblanks *)

(* 2003 July 31: tab is considered a blank character *)

function isblank(c: char): boolean;
(* is the character c blank or tab? *)
begin
   isblank := (c = ' ') or (c = chr(9))
end;

procedure skipblanks(var thefile: text);
(* skip over blanks until a non-blank, or end of line, is found *)
begin
   while isblank(thefile^) and not eoln(thefile) do get(thefile);
end;

procedure skipnonblanks(var thefile: text);
(* skip over nonblanks until a blank, or end of line, is found *)
begin
   while (not isblank(thefile^)) and not eoln(thefile) do get(thefile);
end;

procedure skipcolumn(var thefile: text);
(* skip over a data column *)
begin
   skipblanks(thefile); skipnonblanks(thefile)
end;
(* end module skipblanks version = 4.86; (@ of prgmod.p 2004 Sep 8 *)

(* begin module clearstring *)
procedure clearstring(var ribbon: string);
(* empty the string *)
var   index: integer; (* to the ribbon *)
begin (* clearstring *)
      with ribbon do begin
         for index := 1 to maxstring do letters[index] := ' ';
         length := 0;
         current := 0;
      end
end; (* clearstring *)
procedure initializestring(var ribbon: string);
(* 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. *)
begin (* initializestring *)
   clearstring(ribbon);
   ribbon.next := nil;
end; (* initializestring *)
(* end module clearstring version = 4.59; (@ of prgmod.p 2003 Jul 31 *)

(* begin module interact.writestring *)
(* begin module writestring *)
procedure writestring(var tofile: text; var s: string);
(* write the string s to file tofile, no writeln *)
var   i: integer; (* index to s *)
begin (* writestring *)
      with s do for i := 1 to length do write(tofile, letters[i])
end; (* writestring *)
(* end module writestring version = 4.59; (@ of prgmod.p 2003 Jul 31 *)
(* end module interact.writestring version = 4.59; (@ of prgmod.p 2003 Jul 31 *)

(* begin module grabtoken *)
procedure grabtoken(var thefile: text; var thestring: string);
(* skip any blanks and then grab the next token from the file *)
var
   c: char; (* a character in thefile *)
   done: boolean; (* done finding the name *)
begin
   skipblanks(thefile);
   done := false;
   with thestring do begin
      length := 0;
      while not done do begin
         if eoln(thefile)
         then done := true
         else begin
            read(thefile,c);
            if c = ' '
            then done := true
            else begin
               length := succ(length);
               letters[length] := c;
            end
         end
      end
   end
end;
(* end module grabtoken version = 4.59; (@ of prgmod.p 2003 Jul 31 *)

(* begin module cutoff.themain *)
procedure themain(var data, cutoffp, datacut: text);
(* the main procedure of the program *)
var
   bound: real; (* lower bound for output of the data file *)
   parameterversion: real; (* parameter version number *)

   (* the data column definitions:
   * Columns:
   *  1 piece number
   *  2 piece name
   *  3 sequence region analyzed (if printed, - if not)
   *  4 length of region analyzed on this piece 
   *  5 aligning coordinate on piece
   *  6 Rindividual for the piece
   *  7 value from the values file
   *  8 standard deviation of Rindividual for that sequence
   *)

   (* data items: *)
   number: integer;
   name: string;
   sequence: string;
   length: integer;
   coordinate: integer;
   Rindividual: real;
   value: real;
   stdev: real;

begin
   writeln(output,'cutoff ',version:4:2);
   reset(cutoffp);
   readln(cutoffp, parameterversion);
   if round(100*parameterversion) < round(100*updateversion) then begin
      writeln(output, 'You have an old parameter file!');
      halt
   end;

   readln(cutoffp, bound);
   writeln(output, 'the lower bound is ',bound:4:2);
   rewrite(datacut);
   writeln(datacut, '* bits');
   writeln(datacut, '* cutoff ',version:4:2);
   writeln(datacut, '* the lower bound is ',bound:4:2);

   initializestring(name);
   initializestring(sequence);

   reset(data);
   while not eof(data) do begin
      if data^ = '*' then begin
         copyline(data, datacut);
         writeln(datacut);
      end
      else
         if eoln(data) then begin
            readln(data);
            writeln(datacut);
         end
      else begin

               read(data,     number);
         grabtoken(data,      name); (* name *)
         grabtoken(data,      sequence); (* sequence *)
               read(data,     length);
               read(data,     coordinate);
               read(data,     Rindividual);
               read(data,     value);
               read(data,     stdev);
         readln(data);

         if Rindividual >= bound then begin

(* for debugging
writeln(output,'ri is ', Rindividual:4:2);
*)

            write(datacut,  number:nfield);
            write(datacut,' ');
            writestring(datacut, name);
            write(datacut,' ');
            writestring(datacut, sequence);
            write(datacut,  length:nfield);
            write(datacut,  coordinate:nfield);
            write(datacut,  Rindividual:infofield:infodecim);
            write(datacut,  value:infofield:infodecim);
            write(datacut,  stdev:infofield:infodecim);
            writeln(datacut);

         end
      end
       
   end;

end;
(* end module cutoff.themain *)

begin
   themain(data, cutoffp, datacut);
1: end.