home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.uv.es
/
2014.11.ftp.uv.es.tar
/
ftp.uv.es
/
pub
/
biologia
/
distanc_.exe
/
DISTANCE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-03-18
|
104KB
|
2,962 lines
PROGRAM Distance; (*3.0*)
(****THIS PROGRAM CALCULATES DISTANCES AND OTHER
PARAMETERS OF AN ALIGNMENT OF SEQUENCES****)
(****COPYRIGHT JOSE AGUSTIN LOPEZ BUENO****)
(**** Department of Genetics ****)
(**** University of Valencia ****)
(**** C/ Doctor Moliner, 50 ****)
(**** Burjassot-46100, Valencia, SPAIN ****)
USES Crt, Dos, UnitDist, Help;
CONST enter=#13; esc=#27; nulo =#0; UpArrow =#72;
DoArrow =#80; LeArrow =#75; RiArrow =#77;
PgUp =#73; PgDo =#81; Home =#71; Fin =#79;
WindowForeColor= blue;
WindowTextColor= white;
WindowEdgeColor= white;
TitleColor = yellow;
Mensaje = red;
MaxOptPri = 10;
MaxHelp = 14;
MaxFor = 3;
MaxTable = 6;
MaxWhich = 7;
MaxOutput = 3;
MaxDist = 6;
TYPE tpointer = ^node;
node = record
base : char;
next : tpointer;
end;
tsetseq = array [1..NumMaxSp] of tpointer;
tsetkey = set of char;
Pant = array [1..4000] of byte;
PtrPant = ^Pant;
VAR setseq : tsetseq;
setkey : tsetkey;
i, baswhich, careful,
numSp, dist, counterbas,
TypeOutput, length, format,
transi, transver, hamm,
tablewhich : integer;
mimodo : (mcomando, mmenu);
readFile, writeFile : text;
readpath, writepath : string;
dTajNei, vTajNei : real;
Modo_Video : byte;
Mono : boolean;
Regs : registers;
wwell, ending, flagreadfile,
firstime : boolean;
oopt : integer;
kkey, pathch : char;
PointInt, PointPant : PtrPant;
numventana : integer;
lineaerror, codeerror,
comerror : integer;
OldExitProcAddress : pointer;
setchar : set of char;
(*SELECT VIDEO MODE*)
PROCEDURE ModoVideo;
var parms : registers;
begin
parms.AX := $0F00;
Intr (16, parms);
Modo_Video := LO (parms.AX);
case modo_video of
0,2,5 : mono := true;
else mono := false;
end;
end; (*of procedure*)
(*HIDE THE CURSOR*)
PROCEDURE CursorOff;
begin
Regs.AH := $01;
Regs.CH := $20;
Intr (16, REGS);
end; (*of procedure*)
(*SHOW THE CURSOR*)
PROCEDURE CursorOn;
begin
ModoVideo;
case mono of
false : Regs.CX := $0607;
true : Regs.CX := $0C0D;
end;
Regs.AX := $100;
Intr (16, REGS);
end; (*of procedure*)
(*SCREEN*)
FUNCTION VidSeg:word;
begin
if Mem [$0000:$0449] = 7 then VidSeg := $B000
else VidSeg := $B800;
end;
PROCEDURE Inicializa_Ptr;
begin
New (PointInt);
New (PointPant);
PointPant:=Ptr (VidSeg,$0001);
end;
(*ERROR CODES IMPLEMENTATION*)
{$F+}PROCEDURE MyExitProcedure;{$F-}
var st: string;
begin
if ErrorAddr <> nil then
begin
case codeerror of
0: st:='Undetermined error.';
1: st:='File cannot be openned.';
2: st:='Integer value expected.';
3: st:='Character expected. Possibly wrong input format chosen.';
4: st:='Maximum number of sequences exceeded.';
5: st:='Maximum sequence length exceeded.';
6: st:='Carriage return expected.';
7: st:='End-of-file expected.';
8: st:='File cannot be closed.';
9: st:='String expected.';
10: st:='Species name expected.';
11: st:='Empty file.';
12: st:='Impossible to compute the power function.';
13: st:='Impossible to do the computation.';
14: st:='Results cannot be written.';
15: st:='Wrong character.';
16: st:='File too large for current memory.';
20: st:='Jukes-Cantor''s distance cannot be computed.';
21: st:='Kimura''s 2 par. distance cannot be computed.';
22: st:='Kimura''s 3 par. distance cannot be computed.';
23: st:='Kimura''s 4 par. distance cannot be computed.';
24: st:='Kimura''s 6 par. distance cannot be computed.';
25: st:='Tajima-Nei''s distance cannot be computed.';
26: st:='Jukes-Cantor''s variance cannot be computed.';
27: st:='Kimura''s 2 par. variance cannot be computed.';
28: st:='Kimura''s 3 par. variance cannot be computed.';
end;
textcolor (white);
textbackground (black);
cursoron;
ClrScr;
writeln ('Runtime error number ', ExitCode, ' has ocurred');
writeln ('The error address in decimal is ',
seg(ErrorAddr):5,':',Ofs(ErrorAddr):5);
writeln (st);
if codeerror<20 then writeln ('Error in line ', lineaerror);
ErrorAddr:= nil;
ExitCode:= 0;
end;
ExitProc:= OldExitProcAddress;
end;
(*READING INPUT FROM THE KEYBOARD*)
PROCEDURE ReadingKey (var popcion: char; psetkey: Tsetkey);
begin
repeat
popcion:= readkey;
if (popcion=nulo) then popcion:= readkey
else begin
if ((popcion<>nulo) and (NOT(popcion in psetkey))) then popcion:='(';
end;
until (popcion in psetkey);
end;
(*BEEP!!!!*)
PROCEDURE Beep (frec, duracio: integer);
begin
Sound (frec);
Delay (duracio);
NoSound;
end;
(*MAKE ANOTHER TYPE OF WRITE*)
PROCEDURE WriteXY (px1, py1: integer; c: char);
begin
GotoXY (px1, py1);
write (c);
end;
(*MAKE ANOTHER TYPE OF WINDOW*)
PROCEDURE OtherWindow (x1, y1, x2, y2: integer);
var i:integer;
iu, id, du, dd, t, b: char;
begin
iu:= '╔'; id:= '╚'; du:= '╗'; dd:= '╝'; t:= '═'; b:= '║';
if numventana=1 then textcolor (red) else textcolor(WindowEdgeColor);
textbackground(WindowForeColor);
writexy (x1, y1, iu);
writexy (x2, y1, du);
writexy (x1, y2, id);
writexy (x2, y2, dd);
for i:= x1+1 to x2-1 do
begin
writexy (i, y1, t);
writexy (i, y2, t);
end;
for i:= y1+1 to y2-1 do
begin
writexy (x1, i, b);
writexy (x2, i, b);
end;
window(x1+1,y1+1,x2-1,y2-1);
clrscr;
end;
(*PROGRAM SCREEN*)
PROCEDURE Presentation;
begin
window (1, 1, 80, 25);
textbackground (black);
textcolor (green);
clrscr;
beep (300,100);
writeln;
writeln;
writeln;
writeln;
writeln;
writeln;
writeln;
writeln;
writeln (' Copyright José Agustín López Bueno 1993');
writeln;
writeln (' DISTANCE');
writeln;
writeln;
textbackground (black);
textcolor (white+blink);
gotoxy (26, 14);
writeln;
writeln;
writeln;
textcolor (titlecolor);
textbackground (windowforecolor);
delay (1000);
end; (*of procedure*)
(*CHECK EXISTENCE OF RESULTS FILE*)
PROCEDURE ProcCareful (var pcareful: integer);
const MaxCareful=3;
var well : boolean;
opt : integer;
key : char;
begin
well := false;
Beep (300,100);
OtherWindow (20, 7, 56, 15);
TextBackGround (WindowForeColor);
clrscr;
opt:= 1;
repeat
GotoXY(2,1); begin
textcolor (TitleColor);
Write ('WARNING! THIS FILE ALREADY EXISTS: ');
textcolor (green);
end;
GotoXY(2,2);
GotoXY(2,3); begin
if opt=1 then begin
textbackground (black);
textcolor (white);
end;
Write ('Create a new file with that name.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,4); begin
if opt=2 then begin
textbackground (black);
textcolor (white);
end;
Write ('Add data to the end of that file.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,5); begin
if opt=3 then begin
textbackground (black);
textcolor (white);
end;
Write ('Cancel.');
textbackground (WindowForeColor); textcolor (green);
end;
ReadingKey (key, setkey);
case key of
UpArrow: begin Dec (opt); if opt<1 then opt:= MaxCareful; end;
DoArrow: begin Inc (opt); if opt>MaxCareful then opt:=1; end;
Enter : well:= true;
end;
until well=true;
pcareful:= opt;
textbackground (black);
textcolor (white);
window (1, 1, 80, 25);
end; (*of procedure*)
FUNCTION FileExists (path:string):boolean;
var f: text;
begin
{$I-} assign (f, path); reset (f); close (f); {$I+}
FileExists:= ((IOResult = 0) and (path <> ''));
end;
(*CHOOSE THE READING PATH OF THE SEQUENCE FILE*)
PROCEDURE PathReadFile;
var well, existe : boolean;
begin
well := false;
pathch:= Esc;
Beep (300,100);
window (1, 1, 80, 25);
OtherWindow (10, 9, 70, 14);
repeat
TextBackGround (WindowForeColor);
TextColor (TitleColor);
clrscr;
gotoXY (1,1);
Write (' WRITE THE PATH AND NAME OF THE DNA ALIGNMENT FILE:');
gotoXY (1,3);
Write (' >>>');
cursoron;
textcolor (WindowTextColor);
Readln (readpath);
cursoroff;
existe:= FileExists (readpath);
if existe=false then
begin
well := false;
TextColor (Mensaje);
ClrScr;
beep (300, 100);
writeln;
writeln (' ¡¡¡ WRONG PATH AND/OR FILE NAME !!!');
writeln (' Press Esc to exit, anyother key to continue');
pathch:= ReadKey;
if pathch=Esc then exit;
clrscr;
TextColor (WindowTextColor);
end
else begin well := true; pathch:=' '; end;
until well = true;
cursoroff;
textbackground (windowforecolor);
textcolor (windowtextcolor);
window (1, 1, 80, 25);
end; (*of procedure*)
(*CHOOSE THE WRITTING PATH OF THE RESULTS FILE*)
PROCEDURE PathWriteFile;
var well, existe : boolean;
point2 : ptrPant;
begin
repeat
well := false;
beep (300,100);
window (1, 1, 80, 25);
OtherWindow (10, 9, 70, 14);
TextBackGround (WindowForeColor);
TextColor (TitleColor);
ClrScr;
writeln (' WRITE THE PATH AND NAME OF THE RESULTS FILE:');
writeln;
write (' >>>');
cursoron;
textcolor (WindowTextColor);
readln (writepath);
if writepath='' then writepath:= 'sequence.rst';
cursoroff;
existe:= FileExists (writepath);
if existe=true then
begin
new (point2);
point2^:= pointPant^;
well:= false;
window (1, 1, 80, 25);
ProcCareful (careful);
if careful<>3 then well:= true;
pointPant^:= point2^;
end
else begin careful:= 1; well:= true; end;
until well = true;
cursoroff;
textbackground (windowforecolor);
textcolor (windowtextcolor);
window (1, 1, 80, 25);
end; (*of procedure*)
(*HELP SCREEN*)
PROCEDURE HelpScreen;
var well : boolean;
opt : integer;
key : char;
psetkey: set of char;
begin
psetkey:= [Esc, PgUp, PgDo, Home, Fin];
well := false;
opt:= 1;
window (1, 1, 80, 25);
OtherWindow (2, 2, 79, 24);
repeat
Beep (300,100);
TextBackGround (WindowForeColor);
TextColor (green);
ClrScr;
textbackground (green);
textcolor (red);
GotoXY(35,1); Writeln ('HELP:');
TextBackGround (WindowForeColor);
TextColor (green);
case opt of
1: HelpPag1; (*INDEX*)
2: HelpPag2; (*Ex. Format Phy. New*)
3: HelpPag3; (*Ex. Format Phy. Old*)
4: HelpPag4; (*Ex. Format MSF*)
5: HelpPag5; (*Methods to compute distances, JC*)
6: HelpPag6; (*Methods to compute distances, K2*)
7: HelpPag7; (*Methods to compute distances, K3*)
8: HelpPag8; (*Methods to compute distances, K4*)
9: HelpPag9; (*Methods to compute distances, K6*)
10: HelpPag10; (*Methods to compute distances, TN*)
11: HelpPag11; (*Bases to use*)
12: HelpPag12; (*Code tables*)
13: HelpPag13; (*Output*)
14: HelpPag14; (*Some important notes, Future developments*)
end;
textbackground (green);
textcolor (red);
case opt of
2,3,4,5,6,7,
8,9,10,11,12,13: begin GotoXY(10,21); Write ('Press PgUp, PgDn, Home or End for more help. Esc to Exit.'); end;
1: begin GotoXY(10,21); Write ('Press PgDn or End for more help. Esc to Exit.'); end;
14: begin GotoXY(10,21); Write ('Press PgUp or Home for more help. Esc to Exit.'); end;
end;
ReadingKey (key, psetkey);
case key of
PgUp: begin Dec (opt); if opt<1 then opt:= 1; end;
PgDo: begin Inc (opt); if opt>MaxHelp then opt:= MaxHelp; end;
Home: opt:= 1;
Fin: opt:= MaxHelp;
Esc : well:= true;
end;
until well=true;
textbackground (windowforecolor);
textcolor (windowtextcolor);
window (1, 1, 80, 25);
end; (*of procedure*)
(*CHOOSE THE FILE FORMAT*)
PROCEDURE AskFormat (var pformat: integer);
var well : boolean;
opt : integer;
key : char;
begin
well := false;
Beep (300,100);
window (1, 1, 80, 25);
OtherWindow (18, 10, 61, 17);
TextBackGround (WindowForeColor);
TextColor (green);
clrscr;
opt:= pformat;
repeat
GotoXY(2,1); begin
textcolor (TitleColor);
Write (' FORMAT OF YOUR ALIGNED FILE: ');
textcolor (green);
end;
GotoXY(2,2);
GotoXY(2,3); begin
if opt=1 then begin
textbackground (black);
textcolor (white);
end;
Write ('Interleaved (Phylip version 3.3.).');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,4); begin
if opt=2 then begin
textbackground (black);
textcolor (white);
end;
Write ('Aligned (Phylip older versions).');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,5); begin
if opt=3 then begin
textbackground (black);
textcolor (white);
end;
Write ('MSF format (GCG''s PILEUP program output).');
textbackground (WindowForeColor); textcolor (green);
end;
ReadingKey (key, setkey);
case key of
UpArrow: begin Dec (opt); if opt<1 then opt:= MaxFor; end;
DoArrow: begin Inc (opt); if opt>MaxFor then opt:=1; end;
Enter : begin well:= true; pformat:= opt; end;
Esc : well:= true;
end;
until well=true;
textbackground (windowforecolor);
textcolor (windowtextcolor);
window (1, 1, 80, 25);
end; (*of procedure*)
PROCEDURE AskCodonTableWhich (var ptablewhich: integer);
var well : boolean;
opt : integer;
key : char;
begin
well := false;
Beep (300,100);
window (1, 1, 80, 25);
OtherWindow (20, 10, 59, 20);
TextBackGround (WindowForeColor);
TextColor (green);
clrscr;
opt:= ptablewhich;
repeat
GotoXY(2,1); begin
textcolor (TitleColor);
Write (' CHOOSE THE TRANSLATION CODE TABLE: ');
textcolor (green);
end;
GotoXY(2,2);
GotoXY(2,3); begin
if opt=1 then begin
textbackground (black);
textcolor (white);
end;
Write ('DON''T MAKE THESE COMPUTATIONS.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,4); begin
if opt=2 then begin
textbackground (black);
textcolor (white);
end;
Write ('STANDARD GENETIC CODE.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,5); begin
if opt=3 then begin
textbackground (black);
textcolor (white);
end;
Write ('DROSOPHILA MITOCHONDRIAL CODE.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,6); begin
if opt=4 then begin
textbackground (black);
textcolor (white);
end;
Write ('YEAST MITOCHONDRIAL CODE.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,7); begin
if opt=5 then begin
textbackground (black);
textcolor (white);
end;
Write ('MAMMALIAN MITOCHONDRIAL CODE.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,8); begin
if opt=6 then begin
textbackground (black);
textcolor (white);
end;
Write ('CILIATED CODE.');
textbackground (WindowForeColor); textcolor (green);
end;
ReadingKey (key, setkey);
case key of
UpArrow: begin Dec (opt); if opt<1 then opt:= MaxTable; end;
DoArrow: begin Inc (opt); if opt>MaxTable then opt:=1; end;
Enter : begin well:= true; ptablewhich:= opt; end;
Esc : well:= true;
end;
until well=true;
textbackground (windowforecolor);
textcolor (windowtextcolor);
window (1, 1, 80, 25);
end; (*of procedure*)
(*WHICH BASES TO USE IN COMPUTATIONS*)
PROCEDURE AskWhich (var pbaswhich: integer);
var well : boolean;
opt : integer;
key : char;
begin
well := false;
Beep (300,100);
window (1, 1, 80, 25);
OtherWindow (24, 7, 54, 18);
TextBackGround (WindowForeColor);
TextColor (green);
clrscr;
opt:= pbaswhich;
repeat
GotoXY(2,1); begin
textcolor (TitleColor);
Write ('BASES IN EACH CODON TO USE: ');
textcolor (green);
end;
GotoXY(2,2);
GotoXY(2,3); begin
if opt=1 then begin
textbackground (black);
textcolor (white);
end;
Write ('ALL THE BASES.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,4); begin
if opt=2 then begin
textbackground (black);
textcolor (white);
end;
Write ('FIRST AND SECOND BASES.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,5); begin
if opt=3 then begin
textbackground (black);
textcolor (white);
end;
Write ('FIRST AND THIRD BASES.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,6); begin
if opt=4 then begin
textbackground (black);
textcolor (white);
end;
Write ('SECOND AND THIRD BASES.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,7); begin
if opt=5 then begin
textbackground (black);
textcolor (white);
end;
Write ('FIRST BASE.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,8); begin
if opt=6 then begin
textbackground (black);
textcolor (white);
end;
Write ('SECOND BASE.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,9); begin
if opt=7 then begin
textbackground (black);
textcolor (white);
end;
Write ('THIRD BASE.');
textbackground (WindowForeColor); textcolor (green);
end;
ReadingKey (key, setkey);
case key of
UpArrow: begin Dec (opt); if opt<1 then opt:= MaxWhich; end;
DoArrow: begin Inc (opt); if opt>MaxWhich then opt:=1; end;
Enter : begin well:= true; pbaswhich:= opt; end;
Esc : well:= true;
end;
until well=true;
textbackground (windowforecolor);
textcolor (windowtextcolor);
window (1, 1, 80, 25);
end; (*of procedure*)
(*CHOOSE THE OUTPUT*)
PROCEDURE AskOutput (var ptypeoutput: integer);
var well : boolean;
opt : integer;
key : char;
begin
well := false;
Beep (300,100);
window (1, 1, 80, 25);
OtherWindow (23, 9, 56, 16);
TextBackGround (WindowForeColor);
TextColor (green);
clrscr;
opt:= ptypeoutput;
repeat
GotoXY(2,1); begin
textcolor (TitleColor);
Write (' OUTPUT: ');
textcolor (green);
end;
GotoXY(2,2);
GotoXY(2,3); begin
if opt=1 then begin
textbackground (black);
textcolor (white);
end;
Write ('LARGE (all the matrices). ');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,4); begin
if opt=2 then begin
textbackground (black);
textcolor (white);
end;
Write ('BRIEF (only distances matrix).');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,5); begin
if opt=3 then begin
textbackground (black);
textcolor (white);
end;
Write ('Output for FITCH AND KITSCH.');
textbackground (WindowForeColor); textcolor (green);
end;
ReadingKey (key, setkey);
case key of
UpArrow: begin Dec (opt); if opt<1 then opt:= MaxOutput; end;
DoArrow: begin Inc (opt); if opt>MaxOutput then opt:=1; end;
Enter : begin well:= true; ptypeoutput:= opt; end;
Esc : well:= true;
end;
until well=true;
textbackground (windowforecolor);
textcolor (windowtextcolor);
window (1, 1, 80, 25);
end; (*of procedure*)
(*WHICH DISTANCE TO COMPUTE*)
PROCEDURE AskMethod (var pdist: integer);
var well : boolean;
opt : integer;
key : char;
begin
well := false;
Beep (300,100);
window (1, 1, 80, 25);
OtherWindow (21, 9, 57, 19);
TextBackGround (WindowForeColor);
TextColor (green);
clrscr;
opt:= pdist;
repeat
GotoXY(2,1); begin
textcolor (TitleColor);
Write ('METHOD TO COMPUTE DISTANCES: ');
textcolor (green);
end;
GotoXY(2,2);
GotoXY(2,3); begin
if opt=1 then begin
textbackground (black);
textcolor (white);
end;
Write ('JUKES-CANTOR.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,4); begin
if opt=2 then begin
textbackground (black);
textcolor (white);
end;
Write ('KIMURA''S TWO PARAMETERS.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,5); begin
if opt=3 then begin
textbackground (black);
textcolor (white);
end;
Write ('KIMURA''S THREE PARAMETERS.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,6); begin
if opt=4 then begin
textbackground (black);
textcolor (white);
end;
Write ('KIMURA''S FOUR PARAMETERS.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,7); begin
if opt=5 then begin
textbackground (black);
textcolor (white);
end;
Write ('KIMURA''S SIX PARAMETERS.');
textbackground (WindowForeColor); textcolor (green);
end;
GotoXY(2,8); begin
if opt=6 then begin
textbackground (black);
textcolor (white);
end;
Write ('TAJIMA AND NEI''S FOUR PARAMETERS.');
textbackground (WindowForeColor); textcolor (green);
end;
ReadingKey (key, setkey);
case key of
UpArrow: begin Dec (opt); if opt<1 then opt:= MaxDist; end;
DoArrow: begin Inc (opt); if opt>MaxDist then opt:=1; end;
Enter : begin well:= true; pdist:= opt; end;
Esc : well:= true;
end;
until well=true;
textbackground (windowforecolor);
textcolor (windowtextcolor);
window (1, 1, 80, 25);
end; (*of procedure*)
(*FREE THE POINTER LIST*)
PROCEDURE FreeList;
var i: integer;
p: tpointer;
begin
for i:= 1 to NumMaxSp do
begin
p:= setseq [i];
while p <> nil do
begin
setseq [i]:= p^.next;
dispose (p);
p:= setseq [i];
end;
end;
end; (*of procedure*)
(*SEVERAL PROCEDURES WITH POINTERS*)
PROCEDURE MakeList;
var ind1 : integer;
begin
for ind1 := 1 to NumMaxSp do
begin
setseq [ind1] := nil;
end;
end; (*of procedure*)
PROCEDURE InsertEnd (var list : tpointer; x : char);
var p, q : tpointer;
begin
codeerror:= 16;
new (p);
p^.base := x;
p^.next := nil;
if list = nil then list := p else
begin
q := list;
while q^.next <> nil do q := q^.next;
q^.next := p;
end;
codeerror:= 0;
end; (*of procedure*)
(*POWER OF TWO REALS*)
FUNCTION Power (expon, bas: real):real;
begin
codeerror:= 12;
Power:= exp (expon*ln(bas));
codeerror:= 0;
end;
(*COMPUTE JUKES AND CANTOR'S DISTANCE, 1 PARAMETER*)
FUNCTION dJukesCantor (flong:integer; xac, xag, xat, xtg, xcg, xtc, x_a, x_c, x_g, x_t : real): real;
var fd : real;
begin
codeerror:= 20;
fd := (xac + xag + xat + xtg + xcg + xtc)/flong;
dJukesCantor := (-3/4)*ln(1-((4/3)*fd));
codeerror:= 0;
end; (*of function*)
(*COMPUTE JUKES AND CANTOR'S VARIANCE*)
FUNCTION vJukesCantor (flong:integer; xac, xag, xat, xtg, xcg, xtc, x_a, x_c, x_g, x_t : real): real;
var p : real;
begin
codeerror:= 26;
p := (xac + xag + xat + xtg + xcg + xtc)/flong;
vJukesCantor := (9*p*(1-p))/((sqr(3-(4*p)))*flong);
codeerror:= 0;
end; (*of function*)
FUNCTION FormJC (ps:real): real;
begin
codeerror:= 13;
FormJC := (-3/4)*ln(1-((4/3)*ps));
codeerror:= 0;
end;
(*COMPUTE KIMURA'S DISTANCE, 2 PARAMETERS*)
FUNCTION dKimura2 (flong:integer; xac, xag, xat, xtg, xcg, xtc, x_a, x_c, x_g, x_t : real) : real;
var fp, fq : real;
begin
codeerror:= 21;
fp := (xtc + xag)/flong;
fq := (xat + xcg + xtg + xac)/flong;
dKimura2 := (-1/2) * ln ((1-(2*fp)-fq)*(sqrt(1-(2*fq))));
codeerror:= 0;
end; (*of function*)
(*COMPUTE KIMURA'S VARIANCE, 2 PARAMETERS*)
FUNCTION vKimura2 (flong:integer; xac, xag, xat, xgt, xcg, xct, x_a, x_c, x_g, x_t : real) : real;
var a, b, p, q : real;
begin
codeerror:= 27;
p := (xct + xag)/flong;
q := (xat + xcg + xgt + xac)/flong;
a := (1/(1-(2*p)-q));
b := (1/2)*((1/(1-(2*p)-q)+(1/(1-(2*q)))));
vKimura2 := (1/flong)*((sqr(a)*p)+(sqr(b)*q)-sqr((a*p)+(b*q)));
codeerror:= 0;
end; (*of function*)
(*COMPUTE KIMURA'S DISTANCE, 3 PARAMETERS*)
FUNCTION dKimura3 (flong:integer; xac, xag, xat, xtg, xcg, xtc, x_a, x_c, x_g, x_t : real) : real;
var fp, fq, fr : real;
begin
codeerror:= 22;
fp := (xtc + xag)/flong;
fq := (xat + xcg)/flong;
fr := (xtg + xac)/flong;
dKimura3 := (-1/4)*ln((1-(2*fp)-(2*fq))*(1-(2*fp)-(2*fr))*(1-(2*fq)-(2*fr)));
codeerror:= 0;
end; (*of function*)
(*COMPUTE KIMURA'S VARIANCE, 3 PARAMETERS*)
FUNCTION vKimura3 (flong:integer; xac, xag, xat, xtg, xcg, xtc, x_a, x_c, x_g, x_t : real) : real;
var fp, fq, fr, a, b, c, C12, C13, C23: real;
begin
codeerror:= 28;
fp := (xtc + xag)/flong;
fq := (xat + xcg)/flong;
fr := (xtg + xac)/flong;
C12 := 1/(1-(2*fp)-(2*fq));
C13 := 1/(1-(2*fp)-(2*fr));
C23 := 1/(1-(2*fq)-(2*fr));
a := (C12 + C13)/2;
b := (C12 + C23)/2;
c := (C13 + C23)/2;
vKimura3 := (1/flong)*((sqr(a)*fp)+(sqr(b)*fq)+(sqr(c)*fr))-sqr((a*fp)+(b*fq)+(c*fr));
codeerror:= 0;
end;
(*COMPUTE KIMURA'S DISTANCE, 4 PARAMETERS*)
FUNCTION dKimura4 (flong:integer; xaa, xac, xag, xat, xgg, xgt, xcg, xtt, xct, xcc, x_a, x_c, x_g, x_t : real) : real;
var w, S13, Q1, S24, Q2, fp, fr: real;
m1, m2, x: real;
begin
codeerror:= 23;
xaa := xaa/flong; xac := xac/flong; xag:= xag/flong; xat:= xat/flong;
xgg := xgg/flong; xgt := xgt/flong; xcg:= xcg/flong; xtt:= xtt/flong;
xct := xct/flong; xcc := xcc/flong; x_a:= x_a/flong; x_c:= x_c/flong;
x_g := x_g/flong; x_t := x_t/flong;
w := xaa + xtt + xat + (xag + xac + xct + xgt)/2;
S13 := xaa + xtt;
S24 := xcc + xgg;
Q1 := xat; Q2 := xcg;
fp := xct + xag;
fr := xgt + xac;
m1 := (((S13-Q1)*(S24-Q2))-sqr((fp-fr)/2))/(w*(1-w));
m2 := 1-((fp+fr)/(2*w*(1-w)));
x := (8*w*(1-w))-1;
m2 := power (x, m2);
dKimura4 := (-1/4)*ln(m1*m2);
codeerror:= 0;
end;
(*COMPUTE KIMURA'S DISTANCE, 6 PARAMETERS*)
FUNCTION dKimura6 (flong:integer; xaa, xac, xag, xat, xgg, xgt, xcg, xtt, xct, xcc, x_a, x_c, x_g, x_t : real) : real;
var p, q, qa, qt, qc, qg, b1,
f12, e12, f34, e34, k1, k2, k3,
a, b : real;
begin
codeerror:= 24;
xaa := xaa/flong; xac := xac/flong; xag:= xag/flong; xat:= xat/flong;
xgg := xgg/flong; xgt := xgt/flong; xcg:= xcg/flong; xtt:= xtt/flong;
xct := xct/flong; xcc := xcc/flong; x_a:= x_a/flong; x_c:= x_c/flong;
x_g := x_g/flong; x_t := x_t/flong;
xac := (xac/2);
xat := (xat/2);
xag := (xag/2);
xct := (xct/2);
xcg := (xcg/2);
xgt := (xgt/2);
qa := xaa + xat + xac + xag;
qt := xat + xtt + xct + xgt;
qc := xac + xct + xcc + xcg;
qg := xag + xgt + xcg + xgg;
p := qa + qt;
q := qc + qg;
b1 := (p*q)-(xac+xag+xct+xgt);
f12 := xaa+xtt-xat-(sqr(p))+(3*qa*qt);
f34 := xcc+xgg-xcg-(sqr(q))+(3*qc*qg);
e12 := ((qa*q)-xac-xag)*((qt*q)-xct-xgt);
e34 := ((qc*p)-xac-xct)*((qg*p)-xag-xgt);
k1 := -(p*q)*ln(b1/(p*q));
a := ((p/((3*qa)*qt))*(f12-b1+((3*e12)/b1)));
b := ((q/((3*qc)*qg))*(f34-b1+((3*e34)/b1)));
k2 := -((2*qa*qt)/p)*ln (a);
k3 := -((2*qc*qg)/q)*ln (b);
dKimura6 := k1 + k2 + k3;
codeerror:= 0;
end;
(*COMPUTE TAJIMA AND NEI'S DISTANCE AND VARIANCE, 4 PARAMETERS*)
PROCEDURE TajNei (flong:integer; xaa, xac, xag, xat, xgg, xgt, xcg, xtt, xct, xcc, x_a, x_c, x_g, x_t : real;
var pdTajNei, pvTajNei: real);
var b, c, sumagi, p, qa, qt, qc, qg: real;
begin
codeerror:= 25;
p := (xac + xag + xat + xgt + xcg + xct)/flong;
xaa := xaa/flong; xac := xac/flong; xag:= xag/flong; xat:= xat/flong;
xgg := xgg/flong; xgt := xgt/flong; xcg:= xcg/flong; xtt:= xtt/flong;
xct := xct/flong; xcc := xcc/flong; x_a:= x_a/flong; x_c:= x_c/flong;
x_g := x_g/flong; x_t := x_t/flong;
qa := xaa + (xat + xac + xag)/2;
qt := xtt + (xat + xct + xgt)/2;
qc := xcc + (xct + xac + xcg)/2;
qg := xgg + (xgt + xcg + xag)/2;
c := ((sqr(xac)/(2*qa*qc)) + (sqr(xat)/(2*qa*qt)) + (sqr(xag)/(2*qa*qg)) +
(sqr(xct)/(2*qc*qt)) + (sqr(xcg)/(2*qc*qg)) + (sqr(xgt)/(2*qt*qg)));
sumagi := sqr(qa) + sqr(qt) + sqr(qc) + sqr(qg);
b := (1-sumagi+(sqr(p)/c))/2;
pdTajNei := (-b)*ln (1-(p/b));
pvTajNei := (sqr(b)*p*(1-p))/((sqr(b-p))*flong);
codeerror:= 0;
end; (*of procedure*)
(*READING THE OPTIONS (FIRST) LINE*)
PROCEDURE ReadOptions;
begin
assign (readFile, readPath);
codeerror:= 1;
reset (readFile);
codeerror:= 2;
read (readFile, numSp, length);
codeerror:= 8;
close (readFile);
codeerror:= 0;
end; (*of procedure*)
(*CHECKING THE OPTIONS*)
PROCEDURE CheckOptions;
begin
if (numSp < NumMinSp) then
begin
textcolor (white);
textbackground (black);
clrscr;
writeln ('Too few species. Must be >= ', NumMinSp:4, '.');
cursoron;
halt;
end;
if (numSp > NumMaxSp) then
begin
textcolor (white);
textbackground (black);
clrscr;
writeln ('Too many species. Must be <= ', NumMaxSp:4, '.');
cursoron;
halt;
end;
end; (*of procedure*)
(*INITIALIZE SOME VARIABLES*)
PROCEDURE InitVars;
var ind1, ind2 : integer;
begin
for ind1 := 1 to numSp do
for ind2 := 1 to numSp do
begin
MAA [ind1, ind2] := 0; MGG [ind1, ind2] := 0; MTT [ind1, ind2] := 0;
MCC [ind1, ind2] := 0; MAG [ind1, ind2] := 0; MCT [ind1, ind2] := 0;
MAT [ind1, ind2] := 0; MCG [ind1, ind2] := 0; MAC [ind1, ind2] := 0;
MGT [ind1, ind2] := 0; M_A [ind1, ind2] := 0; M_T [ind1, ind2] := 0;
M_G [ind1, ind2] := 0; M_C [ind1, ind2] := 0; M__ [ind1, ind2] := 0;
DistanceMatrix [ind1, ind2] := 0.0;
lengthcom [ind1, ind2] := 0;
end;
end; (*of procedure*)
(*READING THE SEQUENCE FILE IN OLD PHYLIP FORMAT*)
PROCEDURE ReadingFileOldPhy (ppath : string);
var l, charactercounter, charwithoutdel: integer;
car : char;
otrosetchar: set of char;
begin
textbackground (black);
textcolor (white+blink);
if mimodo=mmenu then
begin
gotoxy (26, 14);
writeln ('READING THE INPUT FILE ...');
end
else
begin
writeln (' READING THE INPUT FILE ...');
end;
textcolor (white);
otrosetchar:= ['A','a','C','c','T','t','G','g','U','u',' ','-'];
lineaerror:= 1;
assign (readfile, ppath);
codeerror:= 1;
reset (readfile);
codeerror:= 6;
readln (readfile);
Inc (lineaerror,1);
for l := 1 to NumMaxSp do
begin
lengthorig [l] := 0;
end;
codeerror:= 3;
for l := 1 to numSp do
begin
charactercounter := 1;
while charactercounter <= LengthNamSp do
begin
read (readfile, car);
insert (car, vNamSp [l], charactercounter);
inc (charactercounter);
end;
Inc (lineaerror);
charactercounter := 0;
charwithoutdel := 0;
while (charactercounter < length) do
begin
read (readfile, car);
if ((car <> ' ') and (car <> #13) and (car <> #10) and (car <> #26)) then
begin
if not (car in otrosetchar) then
begin
textcolor (white);
textbackground (black);
clrscr;
writeln ('Wrong char. Must be A,a,C,c,T,t,G,g,U,u, ,-');
writeln ('Error in line ', lineaerror:5);
writeln ('Check your input format!');
cursoron;
halt;
end;
inc (charactercounter);
if car <> '-' then Inc (charwithoutdel, 1);
if mimodo=mmenu then
begin
GotoXY (19,16);
Writeln (vnamsp [l], ' Char: ', car, ' Num Char: ', charactercounter:7);
end;
InsertEnd (setseq [l], car);
end;
end;
if EOLN (readfile) then readln (readfile);
if EOLN (readfile) then readln (readfile);
lengthorig [l] := charwithoutdel;
end; (*of for*)
codeerror:= 8;
close (readfile);
codeerror:= 0;
lineaerror:= 0;
textbackground (black);
textcolor (white+blink);
if mimodo=mmenu then
begin
gotoxy (26, 14);
writeln ('DOING THE CALCULATIONS ...');
end
else
begin
writeln (' DOING THE CALCULATIONS ...');
end;
textcolor (titlecolor);
textbackground (windowforecolor);
end;
(*READING THE SEQUENCE FILE IN NEW PHYLIP FORMAT*)
PROCEDURE ReadingFileNewPhy (ppath : string);
var l, linecounter, charactercounter,
charwithoutdel : integer;
car : char;
otrosetchar : set of char;
begin
textbackground (black);
textcolor (white+blink);
if mimodo=mmenu then
begin
gotoxy (26, 14);
writeln ('READING THE INPUT FILE ...');
end
else
begin
writeln (' READING THE INPUT FILE ...');
end;
textcolor (white);
otrosetchar:= ['A','a','C','c','T','t','G','g','U','u',' ','-'];
lineaerror:= 1;
assign (readfile, ppath);
codeerror:= 1;
reset (readfile);
codeerror:= 6;
readln (readfile);
Inc (lineaerror);
linecounter := 0;
for l := 1 to NumMaxSp do
begin
lengthorig [l] := 0;
end;
codeerror:= 3;
while not EOF (readfile) do
begin
for l := 1 to numSp do
begin
inc (Linecounter, 1);
if linecounter <= numSp then
begin
charactercounter := 1;
while charactercounter <= LengthNamSp do
begin
read (readfile, car);
insert (car, vNamSp [linecounter], charactercounter);
inc (charactercounter, 1);
end;
charactercounter := 0;
charwithoutdel := 0;
while not EOLN (readfile) do
begin
read (readfile, car);
if car <> ' ' then
begin
if not (car in otrosetchar) then
begin
textcolor (white);
textbackground (black);
clrscr;
writeln ('Wrong char. Must be A,a,C,c,T,t,G,g,U,u, ,-');
writeln ('Error in line ', lineaerror:5);
writeln('Check your input format!');
cursoron;
halt;
end;
inc (charactercounter, 1);
if car <> '-' then Inc (charwithoutdel, 1);
if mimodo=mmenu then
begin
GotoXY (15,16);
Writeln (vnamsp [l], ' Char: ', car, ' Line: ', linecounter:5, ' Num Char: ', charactercounter:7);
end;
InsertEnd (setseq [l], car);
end;
end;
lengthorig [l] := lengthorig [l] + charwithoutdel;
readln (readfile);
Inc (lineaerror);
end
else
begin
charactercounter := 0;
charwithoutdel := 0;
while not EOLN (readfile) do
begin
read (readfile, car);
if car <> ' ' then
begin
if not (car in otrosetchar) then
begin
textcolor (white);
textbackground (black);
clrscr;
writeln ('Wrong char. Must be A,a,C,c,T,t,G,g,U,u, ,-');
writeln (' Error in line ', lineaerror:5);
cursoron;
halt;
end;
inc (charactercounter, 1);
if car <> '-' then Inc (charwithoutdel, 1);
if mimodo=mmenu then
begin
GotoXY (15,16);
Writeln (vnamsp [l], ' Char: ', car, ' Line: ', linecounter:5, ' Num Char: ', charactercounter:7);
end;
InsertEnd (setseq [l], car);
end;
end;
lengthorig [l] := lengthorig [l] + charwithoutdel;
readln (readfile);
Inc (lineaerror);
end;
end; (*of for*)
readln (readFile);
Inc (lineaerror);
end; (*of while*)
codeerror:= 8;
close (readfile);
codeerror:= 0;
lineaerror:= 0;
textbackground (black);
textcolor (white+blink);
if mimodo=mmenu then
begin
gotoxy (26, 14);
writeln ('DOING THE CALCULATIONS ...');
end
else
begin
writeln (' DOING THE CALCULATIONS ...');
end;
textcolor (titlecolor);
textbackground (windowforecolor);
end; (*of procedure*)
(*READING THE SEQUENCE FILE IN MSF FORMAT*)
PROCEDURE ReadingFileMSF (ppath : string);
var car : char;
bor : string[2];
bloquecounter, plength,
charactercounter, l,
cte, i, spcounter,
charwithoutdel : integer;
otrosetchar : set of char;
begin
textbackground (black);
textcolor (white+blink);
if mimodo=mmenu then
begin
gotoxy (26, 14);
writeln ('READING THE INPUT FILE ...');
end
else
begin
writeln (' READING THE INPUT FILE ...');
end;
textcolor (white);
for l := 1 to NumMaxSp do
begin
lengthorig [l] := 0;
end;
otrosetchar:= ['A','a','C','c','T','t','G','g','U','u',' ','.'];
codeerror:= 0;
assign (readfile, ppath);
lineaerror:= 1;
codeerror:= 1;
reset (readfile);
codeerror:= 6;
repeat
readln (readFile, bor); Inc (lineaerror);
until bor='//';
readln (readFile); Inc (lineaerror);
bloquecounter := 1;
spcounter:= 1;
numsp:= 0;
readln (readFile); Inc (lineaerror);
while not EOF (readFile) do
begin
Inc (lineaerror);
if bloquecounter = 1 then
begin
plength:= 0;
charactercounter := 1;
while charactercounter <= LengthNamSp-1 do
begin
read (readfile, car);
insert (car, vNamSp [spcounter], charactercounter);
inc (charactercounter, 1);
end;
insert (' ', vNamSp [spcounter], LengthNamSp);
charwithoutdel := 0;
while not EOLN (readfile) do
begin
read (readfile, car);
if car <> ' ' then
begin
if not (car in otrosetchar) then
begin
textcolor (white);
textbackground (black);
clrscr;
writeln ('Wrong char. Must be A,a,C,c,T,t,G,g,U,u, ,.');
writeln (' Error in line ', lineaerror:5);
writeln('Check your input format!');
cursoron;
halt;
end;
inc (plength, 1);
if car <> '.' then Inc (charwithoutdel, 1);
if mimodo=mmenu then
begin
GotoXY (20,16);
Writeln (vnamsp [spcounter], ' Char: ', car, ' Num Char: ', plength:7);
end;
InsertEnd (setseq [spcounter], car);
end;
end;
lengthorig [spcounter]:= charwithoutdel;
readln (readfile); Inc (lineaerror);
Inc (spcounter);
if EOLN (readFile) then begin
numSp := spcounter-1;
Inc (bloqueCounter);
spcounter:= 1;
readln (readFile); readln (readFile); Inc (lineaerror,2);
cte:= plength;
end;
end
else
begin
Inc (lineaerror);
plength:= cte;
for i:= 1 to LengthNamSp-1 do read (readFile, car);
charwithoutdel := 0;
while not EOLN (readfile) do
begin
read (readfile, car);
if car <> ' ' then
begin
if not (car in otrosetchar) then
begin
textcolor (white);
textbackground (black);
clrscr;
writeln ('Wrong char. Must be A,a,C,c,T,t,G,g,U,u, ,.');
writeln (' Error in line ', lineaerror:5);
writeln('Check your input format!');
cursoron;
halt;
end;
inc (plength, 1);
if car <> '.' then Inc (charwithoutdel, 1);
if mimodo=mmenu then
begin
GotoXY (20,16);
Writeln (vnamsp [spcounter], ' Char: ', car, ' Num Char: ', plength:7);
end;
InsertEnd (setseq [spcounter], car);
end;
end;
lengthorig [spcounter]:= lengthorig [spcounter] + charwithoutdel;
readln (readfile); Inc (lineaerror);
Inc (spcounter);
if EOLN (readFile) then begin
Inc (lineaerror);
Inc (bloqueCounter);
spcounter:= 1;
readln (readFile); readln (readFile); Inc (lineaerror,2);
cte:= plength;
end;
end; (*of else*)
end; (*of while*)
length:= plength;
if (numSp < NumMinSp) then
begin
textcolor (white);
textbackground (black);
clrscr;
writeln ('Too few species. Must be >= ', NumMinSp:4, '.');
cursoron;
halt;
end;
if (numSp > NumMaxSp) then
begin
textcolor (white);
textbackground (black);
clrscr;
writeln ('Too many species. Must be <= ', NumMaxSp:4, '.');
cursoron;
halt;
end;
close (readfile);
codeerror:= 0;
lineaerror:= 0;
textbackground (black);
textcolor (white+blink);
if mimodo=mmenu then
begin
gotoxy (26, 14);
writeln ('DOING THE CALCULATIONS ...');
end
else
begin
writeln (' DOING THE CALCULATIONS ...');
end;
textcolor (titlecolor);
textbackground (windowforecolor);
end; (*of procedure*)
(*MAKING THE BASES PAIRS MATRIX*)
PROCEDURE MakingMatrix;
var ind1, ind2 : integer;
a, b, d : char;
p, q : tpointer;
k, cont2 : integer;
begin
if ((format=1) or (format=2)) then d:='-' else d:='.';
for ind1 := 1 to numSp do
for ind2 := 1 to numSp do
begin
MAA [ind1, ind2]:= 0; MCC [ind1, ind2]:= 0; MTT [ind1, ind2]:= 0;
MGG [ind1, ind2]:= 0; MAC [ind1, ind2]:= 0; MAT [ind1, ind2]:= 0;
MAG [ind1, ind2]:= 0; MCG [ind1, ind2]:= 0; MCT [ind1, ind2]:= 0;
MGT [ind1, ind2]:= 0; M_A [ind1, ind2]:= 0; M_C [ind1, ind2]:= 0;
M_T [ind1, ind2]:= 0; M_G [ind1, ind2]:= 0; M__ [ind1, ind2]:= 0;
end;
for ind1 := 1 to numSp do
begin
for ind2 := ind1+1 to numSp do
begin
counterbas:= 0; cont2:= 0;
p := setseq [ind1]; q := setseq [ind2];
while (p <> nil) and (q <> nil) do
begin
if counterbas=0 then
begin
case baswhich of
1 : begin end;
2 : begin end;
3 : begin end;
4 : begin p:= p^.next; q:= q^.next; end;
5 : begin end;
6 : begin p:= p^.next; q:= q^.next; end;
7 : begin
p:= p^.next; q:= q^.next;
p:= p^.next; q:= q^.next;
end;
end;
end;
a := p^.base; b := q^.base;
Inc (counterbas); Inc (cont2);
if ((a='A') and (b='A')) then Inc (MAA[ind1, ind2],1);
if ((a='C') and (b='C')) then Inc (MCC[ind1, ind2],1);
if ((a='G') and (b='G')) then Inc (MGG[ind1, ind2],1);
if ((a='T') and (b='T')) then Inc (MTT[ind1, ind2],1);
if ((a=d) and (b=d)) then Inc (M__[ind1, ind2],1);
if ((a='A') and (b='C')) or ((a='C') and (b='A'))
then Inc (MAC[ind1, ind2],1);
if ((a='A') and (b='G')) or ((a='G') and (b='A'))
then Inc (MAG[ind1, ind2],1);
if ((a='A') and (b='T')) or ((a='T') and (b='A'))
then Inc (MAT[ind1, ind2],1);
if ((a='C') and (b='G')) or ((a='G') and (b='C'))
then Inc (MCG[ind1, ind2],1);
if ((a='C') and (b='T')) or ((a='T') and (b='C'))
then Inc (MCT[ind1, ind2],1);
if ((a='G') and (b='T')) or ((a='T') and (b='G'))
then Inc (MGT[ind1, ind2],1);
if ((a='A') and (b=d)) or ((a=d) and (b='A'))
then Inc (M_A[ind1, ind2],1);
if ((a='C') and (b=d)) or ((a=d) and (b='C'))
then Inc (M_C[ind1, ind2],1);
if ((a='G') and (b=d)) or ((a=d) and (b='G'))
then Inc (M_G[ind1, ind2],1);
if ((a='T') and (b=d)) or ((a=d) and (b='T'))
then Inc (M_T[ind1, ind2],1);
case baswhich of
1 : begin p := p^.next; q := q^.next; end;
2 : begin
p := p^.next; q := q^.next;
if ((((cont2-2) MOD 3)=0) and (p<>nil)) then begin Inc (cont2); p:= p^.next; q := q^.next; end;
end;
3 : begin
p := p^.next; q := q^.next;
if ((((cont2-1) MOD 3)=0) and (p<>nil)) then begin Inc (cont2); p:= p^.next; q := q^.next; end;
end;
4 : begin
p := p^.next; q := q^.next;
if ((((cont2+1) MOD 3)=0) and (p<>nil)) then begin Inc (cont2); p:= p^.next; q := q^.next; end;
end;
5 : begin
k:= 1;
while ((k<=3) and (p<>nil)) do
begin
p:= p^.next; q:= q^.next;
Inc (k);
end;
end;
6 : begin
k:= 1;
while ((k<=3) and (p<>nil)) do
begin
p:= p^.next; q:= q^.next;
Inc (k);
end;
end;
7 : begin
k:= 1;
while ((k<=3) and (p<>nil)) do
begin
p:= p^.next; q:= q^.next;
Inc (k);
end;
end;
end; (*of case*)
end; (*of while*)
end;
end;
end; (*of procedure*)
(*READING THE CODON USAGE TABLE*)
PROCEDURE ReadingCodonTable (ptablewhich: integer);
var ftable: text;
i, j, k : integer;
value: char;
begin
case ptablewhich of
2: assign (ftable, 'standnuc.tab');
3: assign (ftable, 'drosomit.tab');
4: assign (ftable, 'yeastmit.tab');
5: assign (ftable, 'mammit.tab');
6: assign (ftable, 'ciliated.tab');
end;
reset (ftable);
readln (ftable);
for i:=1 to 21 do
begin
for j:=1 to 6 do
begin
read (ftable, value);
end;
for j:=1 to 8 do
begin
for k:=1 to 3 do
begin
read (ftable, value);
codontable [i, j, k]:= value;
end;
if j=8 then readln (ftable, value) else read (ftable, value);
end;
end;
close (ftable);
end; (*of procedure*)
(*CALCULATE THE SYNONYMOUS AND NON SYNONYMOUS MATRIX*)
PROCEDURE MakSyn_NonSynMatrix;
type tcodon= array [1..3] of char;
var codon1, codon2,
codon3, codon4 : tcodon;
aa1, aa2, aa3, aa4 : integer;
ind1, ind2, ind3 : integer;
syn, nonsyn : real;
ssyn, snonsyn : real;
aversyn, avernonsyn,
taversyn,
tavernonsyn : real;
paths, diff,
a, b : integer;
numaas : integer;
p, q, r : tpointer;
part : boolean;
d : char;
function NumDiff (fcodon1, fcodon2: tcodon): integer;
var i, x: integer;
begin
x:=0;
for i:= 1 to 3 do
begin
if fcodon1[i]<>fcodon2[i] then inc (x);
end;
NumDiff:= x;
end;
function CodCodon (fcodon: tcodon): integer;
var i, j, x: integer;
h: boolean;
begin
h:= false;
i:= 1; j:= 1;
while (h=false) do
begin
if fcodon=codontable[i,j] then begin x:=i; h:=true; end;
inc (j);
if j=9 then begin j:=1; inc(i); end;
end;
CodCodon:= x;
end;
procedure FindDiff (fcodon1, fcodon2: tcodon; var pa, pb: integer);
begin
if fcodon1[1]<>fcodon2[1] then
begin
pa:=1;
if fcodon1[2]<>fcodon2[2] then pb:=2 else pb:=3;
end
else begin pa:=2; pb:=3; end;
end;
begin
if ((format=1) or (format=2)) then d:='-' else d:='.';
for ind1 := 1 to NumSp do
begin
AverSitNonSyn [ind1]:= 0;
AverSitSyn [ind1]:= 0;
for ind2 := 1 to NumSp do
begin
SynMatrix [ind1, ind2]:= 0;
NonSynMatrix [ind1, ind2]:= 0;
end;
end;
for ind1:= 1 to NumSp do
begin
numaas:= 0;
taversyn:= 0; tavernonsyn:= 0;
r := setseq [ind1];
while r <> nil do
begin
for ind3:=1 to 3 do codon1[ind3]:= '*';
ind3:=1;
while ((ind3<=3) and (r <> nil)) do
begin
codon1 [ind3] := r^.base;
r:= r^.next;
inc (ind3);
end;
part:=false;
for ind3:=1 to 3 do
begin
if ((codon1[ind3]='*') or (codon1[ind3]=d)) then part:=true;
end;
if part=false then
begin
aversyn:= 0; avernonsyn:= 0;
Inc (numaas);
aa1:= CodCodon (codon1);
codon2:= codon1;
for ind3:= 1 to 3 do
begin
case codon1[ind3] of
'A': begin
codon2[ind3]:='C';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
codon2[ind3]:='T';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
codon2[ind3]:='G';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
end;
'C': begin
codon2[ind3]:='A';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
codon2[ind3]:='T';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
codon2[ind3]:='G';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
end;
'G': begin
codon2[ind3]:='C';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
codon2[ind3]:='T';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
codon2[ind3]:='A';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
end;
'T': begin
codon2[ind3]:='C';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
codon2[ind3]:='A';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
codon2[ind3]:='G';
aa2:= CodCodon (codon2);
if aa2=aa1 then aversyn:=aversyn+1 else avernonsyn:=avernonsyn+1;
codon2:= codon1;
end;
end; (*case*)
end;(*for aa*)
aversyn:= aversyn/3; avernonsyn:=avernonsyn/3;
taversyn:= taversyn+aversyn; tavernonsyn:= tavernonsyn+avernonsyn;
end; (*for part*)
end; (*while seq*)
AverSitSyn [ind1]:= taversyn; AverSitNonSyn [ind1]:= tavernonsyn;
end; (*of specie*)
for ind1 := 1 to NumSp do
begin
for ind2 := ind1+1 to numSp do
begin
ssyn:=0; snonsyn:=0;
p := setseq [ind1]; q := setseq [ind2];
while ((p <> nil) and (q <> nil)) do
begin
for ind3:=1 to 3 do begin codon1[ind3]:='*'; codon2[ind3]:='*'; end;
ind3:=1;
while ((ind3<=3) and ((p <> nil) and (q <> nil))) do
begin
codon1 [ind3] := p^.base; codon2 [ind3] := q^.base;
p:= p^.next; q:= q^.next;
inc (ind3);
end;
part:=false;
for ind3:=1 to 3 do
begin
if ((codon1[ind3]='*') or (codon2[ind3]='*') or
(codon1[ind3]=d) or (codon2[ind3]=d)) then part:=true;
end;
if part=false then
begin
aa1:= CodCodon (codon1); aa2:= CodCodon (codon2);
diff:= NumDiff (codon1, codon2);
syn:= 0; nonsyn:= 0;
case diff of
0: begin
paths:=1;
syn:=0; nonsyn:=0;
end;
1: begin
paths:=1;
if aa1=aa2 then syn:=syn+1 else nonsyn:=nonsyn+1;
end;
2: begin
paths:=2;
FindDiff (codon1, codon2, a, b);
codon3:= codon1;
codon3[a]:= codon2[a];
aa3:= CodCodon (codon3);
if aa3<>21 then
begin
if ((aa1=aa3) and (aa3=aa2)) then syn:= syn+2;
if ((aa1<>aa3) and (aa3=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+1; end;
if ((aa1<>aa3) and (aa3<>aa2)) then nonsyn:= nonsyn+2;
end
else Dec (paths);
codon3:= codon1;
codon3[b]:= codon2[b];
aa3:= CodCodon (codon3);
if aa3<>21 then
begin
if ((aa1=aa3) and (aa3=aa2)) then syn:= syn+2;
if ((aa1<>aa3) and (aa3=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+1; end;
if ((aa1<>aa3) and (aa3<>aa2)) then nonsyn:= nonsyn+2;
end
else Dec (paths);
if paths>0 then
begin
syn:= syn/paths;
nonsyn:= nonsyn/paths;
end
else begin syn:=0; nonsyn:=0; end;
end;
3: begin
paths:=6;
codon3:= codon1; codon4:= codon2;
codon3[1]:= codon2[1]; codon4[2]:= codon1[2];
aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
if ((aa3<>21) and (aa4<>21)) then
begin
if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
end
else Dec (paths);
codon3:= codon1; codon4:= codon2;
codon3[1]:= codon2[1]; codon4[3]:= codon1[3];
aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
if ((aa3<>21) and (aa4<>21)) then
begin
if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
end
else Dec (paths);
codon3:= codon1; codon4:= codon2;
codon3[2]:= codon2[2]; codon4[1]:= codon1[1];
aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
if ((aa3<>21) and (aa4<>21)) then
begin
if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
end
else Dec (paths);
codon3:= codon1; codon4:= codon2;
codon3[2]:= codon2[2]; codon4[3]:= codon1[3];
aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
if ((aa3<>21) and (aa4<>21)) then
begin
if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
end
else Dec (paths);
codon3:= codon1; codon4:= codon2;
codon3[3]:= codon2[3]; codon4[1]:= codon1[1];
aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
if ((aa3<>21) and (aa4<>21)) then
begin
if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
end
else Dec (paths);
codon3:= codon1; codon4:= codon2;
codon3[3]:= codon2[3]; codon4[2]:= codon1[2];
aa3:= CodCodon (codon3); aa4:= CodCodon (codon4);
if ((aa3<>21) and (aa4<>21)) then
begin
if ((aa1=aa3) and (aa3=aa4) and (aa4=aa2)) then syn:= syn+3;
if ((aa1=aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4=aa2)) then begin syn:= syn+2; nonsyn:= nonsyn+1; end;
if ((aa1=aa3) and (aa3<>aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3=aa4) and (aa4<>aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4=aa2)) then begin syn:= syn+1; nonsyn:= nonsyn+2; end;
if ((aa1<>aa3) and (aa3<>aa4) and (aa4<>aa2)) then nonsyn := nonsyn+3;
end
else Dec (paths);
if paths>0 then
begin
syn:= syn/paths;
nonsyn:= nonsyn/paths;
end
else begin syn:=0; nonsyn:=0; end;
end;
end; (*of case*)
ssyn:= ssyn+syn; snonsyn:= snonsyn+nonsyn;
end; (*if*)
end; (*while*)
SynMatrix[ind1, ind2]:= ssyn; NonSynMatrix[ind1, ind2]:= snonsyn;
end; (*for*)
end; (*for*)
end; (*of procedure*)
(*CALCULATE THE COMUN DISTANCE MATRIX*)
PROCEDURE MakLenghtComMatrix;
var i, j : integer;
begin
for i := 1 to numSp do
for j := 1 to numSp do
begin
lengthcom [i, j] := MAA [i,j]+MCC [i,j]+MGG [i,j]+MTT [i,j]+MAC [i,j]+
MAG [i,j]+MAT [i,j]+MCG [i,j]+MCT [i,j]+MGT [i,j];
end;
end; (*of procedure*)
(*CALCULATE THE DISTANCE MATRIX*)
PROCEDURE MakDistanceMatrix;
var i, j : integer;
begin
for i := 1 to numSp do
for j := i+1 to numSp do
begin
case dist of
1 : begin (*JUKES-CANTOR*)
DistanceMatrix [i, j] :=
dJukesCantor (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGT[i,j],MCG[i,j],
MCT [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
VarianceMatrix [i, j] :=
vJukesCantor (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGT[i,j],MCG[i,j],
MCT [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
end;
2 : begin (*KIMURA2*)
DistanceMatrix [i, j] :=
dKimura2 (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGt[i,j],MCG[i,j],
MCt [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
VarianceMatrix [i, j] :=
vKimura2 (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGT[i,j],MCG[i,j],
MCT [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
end;
3 : begin (*KIMURA3*)
DistanceMatrix [i, j] :=
dKimura3 (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGt[i,j],MCG[i,j],
MCt [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
VarianceMatrix [i, j] :=
vKimura3 (lengthcom[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGT[i,j],MCG[i,j],
MCT [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
end;
4 : begin (*KIMURA4*)
DistanceMatrix [i, j] :=
dKimura4 (lengthcom[i,j],MAA[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGG[i,j],MGT[i,j],MCG[i,j],
MTT[i,j],MCT [i,j], MCC [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
end;
5 : begin (*KIMURA6*)
DistanceMatrix [i, j] :=
dKimura6 (lengthcom[i,j],MAA[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGG[i,j],MGT[i,j],MCG[i,j],
MTT[i,j],MCT [i,j], MCC [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j]);
end;
6 : begin (*TAJIMA AND NEI*)
TajNei (lengthcom[i,j],MAA[i,j],MAC[i,j],MAG [i,j],MAT[i,j],MGG[i,j],MGT[i,j],MCG[i,j],
MTT[i,j],MCT [i,j], MCC [i,j], M_A [i,j], M_C [i,j], M_G[i,j], M_T[i,j],
dTajNei, vTajNei);
DistanceMatrix [i, j] := dTajNei;
VarianceMatrix [i, j] := vTajNei;
end;
end; (*of case*)
end; (*of for*)
end; (*of procedure*)
(*WRITING RESULTS*)
PROCEDURE WritingResults;
var ind1, ind2 : integer;
tira1, tira2,
tira3, tira4,
tira5 : string[40];
real1, real2 : real;
begin
codeerror:= 14;
case dist of
1 : tira1 := 'JUKES-CANTOR ';
2 : tira1 := 'KIMURA 2 PARAMETERS ';
3 : tira1 := 'KIMURA 3 PARAMETERS ';
4 : tira1 := 'KIMURA 4 PARAMETERS ';
5 : tira1 := 'KIMURA 6 PARAMETERS ';
6 : tira1 := 'TAJIMA-NEI ';
end;
case TypeOutput of
1 : tira2 := 'LARGE OUTPUT FILE';
2 : tira2 := 'BRIEF OUTPUT FILE';
3 : tira2 := 'OUTPUT FOR FITCH AND KITSCH';
end;
case Format of
1 : tira3 := 'INTERLEAVED (PHYLIP VERSION 3.3.)';
2 : tira3 := 'ALIGNED (PHYLIP OLDER VERSIONS)';
3 : tira3 := 'MSF FORMAT (GCG''s PILEUP PROGRAM RESULT)';
end;
case baswhich of
1 : tira4 := 'ALL THE BASES';
2 : tira4 := '1st AND 2nd BASES';
3 : tira4 := '1st AND 3rd BASES';
4 : tira4 := '2st AND 3rd BASES';
5 : tira4 := '1st BASE';
6 : tira4 := '2nd BASE';
7 : tira4 := '3rd BASE';
end;
case tablewhich of
1 : tira5 := '';
2 : tira5 := 'STANDARD CODE.';
3 : tira5 := 'DROSOPHILA MITOCHONDRIAL.';
4 : tira5 := 'YEAST MITOCHONDRIAL.';
5 : tira5 := 'MAMMALIAN MITOCHONDRIAL.';
6 : tira5 := 'CILIATED.';
end;
if ((TypeOutput = 1) or (TypeOutput = 2)) then
begin
writeln (writeFile);
writeln (writeFile, ' DISTANCE 3.0. 1993 J.A. López Bueno');
writeln (writeFile);
writeln (writeFile, 'The DNA sequence file is: ', readPath);
writeln (writeFile, 'The results file is: ', writePath);
writeln (writeFile, 'The number of species is: ', numSp);
writeln (writeFile, 'The aligned sequences length is: ', length);
writeln (writeFile, 'The program options are: ');
writeln (writeFile, ' Distance method: ', tira1);
writeln (writeFile, ' Output: ', tira2);
writeln (writeFile, ' Format: ', tira3);
writeln (writeFile, ' Using counter base option: ', tira4);
writeln (writeFile, 'The number of bases being');
writeln (writeFile, ' considered is: ', counterbas);
writeln (writeFile);
end;
if TypeOutput = 1 then
begin
writeln (writeFile, 'The vector length -without deletions- is: ');
for ind1 :=1 to numSp do
begin
writeln (writeFile, vNamSp[ind1], lengthorig [ind1]:10);
end;
writeln (writeFile);
writeln (writeFile, 'The common length matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, lengthcom[ind2,ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The Hamming distance matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writeFile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
hamm := MAC[ind2,ind1]+MAG[ind2,ind1]+MAT[ind2,ind1]+
MCG[ind2,ind1]+MCT[ind2,ind1]+MGT[ind2,ind1];
write (writeFile, hamm:10);
end;
writeln (writeFile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The transitions matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
transi := MAG[ind2,ind1]+MCT[ind2,ind1];
write (writeFile, transi:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The transversions matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
transver := MAC[ind2,ind1]+MAT[ind2,ind1]+MCG[ind2,ind1]+MGT[ind2,ind1];
write (writeFile, transver:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
if ((baswhich=1) and (tablewhich<>1)) then
begin
writeln (writeFile, 'Translation code table used: ', tira5);
writeln (writeFile);
writeln (writeFile, ' The proportion of synonymous differences matrix is: ');
writeln (writeFile, ' (unweighted pathway method, Nei and Gojobori)');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile,
((SynMatrix[ind2, ind1]/((AverSitSyn[ind1]+AverSitSyn[ind2])/2))):10:4);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, ' The proportion of non synonymous differences matrix is: ');
writeln (writeFile, ' (unweighted pathway method, Nei and Gojobori)');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile,
((NonSynMatrix[ind2, ind1]/((AverSitNonSyn[ind1]+AverSitNonSyn[ind2])/2))):10:4);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, ' Matrix of synonymous substitutions per site is: ');
writeln (writeFile, ' (unweighted pathway method, Nei and Gojobori)');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
real1:= (SynMatrix[ind2, ind1]/((AverSitSyn[ind1]+AverSitSyn[ind2])/2));
real2:= FormJC (real1);
write (writeFile, real2:10:4);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, ' Matrix of nonsynonymous substitutions per site is: ');
writeln (writeFile, ' (unweighted pathway method, Nei and Gojobori)');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
real1:= (NonSynMatrix[ind2, ind1]/((AverSitNonSyn[ind1]+AverSitNonSyn[ind2])/2));
real2:= FormJC (real1);
write (writeFile, real2:10:4);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
end;
writeln (writeFile);
writeln (writeFile, 'The A-to-A matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, MAA[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The C-to-C matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, MCC[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The G-to-G matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, MGG[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The T-to-T matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, MTT[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The A-to-C matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, MAC[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The A-to-G matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, MAG[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The A-to-T matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, MAT[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The C-to-G matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, MCG[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The C-to-T matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, MCT[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The G-to-T matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, MGT[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The ''-''-to-A matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, M_A[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The ''-''-to-C matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, M_C[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The ''-''-to-G matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, M_G[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The ''-''-to-T matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, M_T[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
writeln (writeFile, 'The ''-''-to-''-'' matrix is: ');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writefile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write (writeFile, M__[ind2, ind1]:10);
end;
writeln (writefile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
end;
if ((TypeOutput = 1) or (TypeOutput = 2)) then
begin
writeln (writeFile, 'THE MATRIX OF ', tira1, 'DISTANCE ESTIMATES IS :');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writeFile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write(writeFile, DistanceMatrix[ind2, ind1]:10:4);
end;
writeln (writeFile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
if ((dist=1) or (dist=2) or (dist=3) or (dist=6)) then
begin
writeln (writeFile, 'THE MATRIX OF VARIANCES OF ', tira1, 'ESTIMATES IS :');
writeln (writeFile);
for ind1 :=2 to numSp do
begin
write (writeFile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write(writeFile, VarianceMatrix [ind2, ind1]:10:4);
end;
writeln (writeFile);
end;
write (writeFile, ' ');
for ind1 := 1 to numSp-1 do write (writeFile, vNamSp[ind1]);
writeln (writeFile);
writeln (writeFile);
end;
writeln (writefile, '***************************************************');
writeln (writefile, '***************************************************');
writeln (writefile);
end;
if (TypeOutput = 3) then
begin
writeln (writefile, NumSp);
writeln (writeFile, vNamSp[1]);
for ind1 :=2 to numSp do
begin
write (writeFile, vNamSp[ind1]);
for ind2 :=1 to ind1-1 do
begin
write(writeFile, DistanceMatrix[ind2, ind1]:10:4);
end;
writeln (writeFile);
end;
writeln (writeFile);
end;
codeerror:= 0;
end; (*of procedure*)
(*BYE!!!*)
PROCEDURE TheEnd;
begin
textcolor (white);
textbackground (black);
writeln;
writeln;
writeln;
writeln;
writeln ('End of program.');
writeln ('This program has been written by J. A. López Bueno.');
writeln ('Department of Genetics.');
writeln ('University of Valencia.');
writeln ('C/ Dr. Moliner, n. 50, Burjassot, Valencia-46100, SPAIN.');
writeln ('Suggestions, questions and/or bug reports will be wellcome.');
writeln;
end; (*of procedure*)
PROCEDURE Default;
begin
readpath := 'sequence.seq';
writepath := 'sequence.rst';
format := 1;
dist := 2;
baswhich := 1;
tablewhich:= 1;
typeoutput:= 1;
end; (*of procedure*)
PROCEDURE DoCommandLine;
var cexiste: boolean;
begin
Default;
if ParamStr (1) <> '' then begin
ReadPath:= ParamStr (1);
end;
cexiste:= FileExists (ReadPath);
if cexiste=false then begin
writeln ('Error. I don''t find the input file...');
Halt;
end;
if ParamStr (2) <> '' then begin
WritePath:= ParamStr (2);
end;
if ParamStr (3) <> '' then begin
val (ParamStr(3), format, comerror);
if comerror <> 0 then
begin
writeln ('Error. Integer value expected...');
writeln ('The value must be> 0 and <=',MaxFor:3);
Halt;
end;
if ((format > MaxFor) or (format < 1)) then
begin
writeln ('Error. The value must be > 0 and <=',MaxFor:3);
Halt;
end;
end;
if ParamStr (4) <> '' then begin
val (ParamStr(4), dist, comerror);
if comerror <> 0 then
begin
writeln ('Error. Integer value expected...');
writeln ('Value for distance must be> 0 and <=',MaxDist:3);
Halt;
end;
if ((dist > MaxDist) or (dist < 1)) then
begin
writeln ('Error. Value for distance must be > 0 and <=',MaxDist:3);
Halt;
end;
end;
if ParamStr (5) <> '' then begin
val (ParamStr(5), baswhich, comerror);
if comerror <> 0 then
begin
writeln ('Error. Integer value expected...');
writeln ('Value for bases must be > 0 and <=',MaxWhich:3);
Halt;
end;
if ((BasWhich > MaxWhich) or (BasWhich < 1)) then
begin
writeln ('Error. Value for bases must be > 0 and <=',MaxWhich:3);
Halt;
end;
end;
if ParamStr (6) <> '' then begin
val (ParamStr(6), tablewhich, comerror);
if comerror <> 0 then
begin
writeln ('Error. Integer value...');
writeln ('Value for code table must be > 0 and <=',MaxTable:3);
Halt;
end;
if ((TableWhich > MaxTable) or (TableWhich < 1)) then
begin
writeln ('Error. Value for code table must be > 0 and <=',MaxTable:3);
Halt;
end;
end;
if ParamStr (7) <> '' then begin
val (ParamStr(7), typeoutput, comerror);
if comerror <> 0 then
begin
writeln ('Error. Integer value expected...');
writeln ('Value for output must be > 0 and <=',MaxOutput:3);
Halt;
end;
if ((TypeOutput > MaxOutput) or (TypeOutput < 1)) then
begin
writeln ('Error. Value for output must be > 0 and <=',MaxOutput:3);
Halt;
end;
end;
end;
BEGIN
checkbreak:= true; SetCBreak (true);
setchar:= ['A','a','C','c','T','t','G','g','U','u','-'];
codeerror:= 0;
OldExitProcAddress:= ExitProc;
ExitProc:= @MyExitProcedure;
if ParamCount < 1 then (*MENU DRIVEN PROGRAM*)
begin
mimodo:= mmenu;
CursorOff;
ending:= false;
flagreadfile:= false;
ClrScr;
Beep (300,100);
numventana:= 1;
careful:= -1;
GotoXY (20,6);
write (' DISTANCE 3.0. 1993 J.A. López Bueno');
OtherWindow (20, 7, 59, 21);
numventana:= 0;
TextBackGround (WindowForeColor);
TextColor (yellow);
clrscr;
oopt:= 1;
Inicializa_Ptr;
Default;
firstime:= true;
setkey:= [Enter,Esc, UpArrow, DoArrow];
MakeList;
repeat
repeat
wwell := false;
GotoXY(2,1); begin
textcolor (green);
Write (' MAIN MENU:');
textcolor (yellow);
end;
GotoXY(2,2);
GotoXY(2,3); begin
if oopt=1 then begin
textbackground (black);
textcolor (green);
end;
Write ('Path and name of the sequences file.');
textbackground (WindowForeColor); textcolor (yellow);
end;
GotoXY(2,4); begin
if oopt=2 then begin
textbackground (black);
textcolor (green);
end;
Write ('Path and name of the results file.');
textbackground (WindowForeColor); textcolor (yellow);
end;
GotoXY(2,5); begin
if oopt=3 then begin
textbackground (black);
textcolor (green);
end;
Write ('Format of your aligned file.');
textbackground (WindowForeColor); textcolor (yellow);
end;
GotoXY(2,6); begin
if oopt=4 then begin
textbackground (black);
textcolor (green);
end;
Write ('Method to compute distances.');
textbackground (WindowForeColor); textcolor (yellow);
end;
GotoXY(2,7); begin
if oopt=5 then begin
textbackground (black);
textcolor (green);
end;
Write ('Bases in each codon to use.');
textbackground (WindowForeColor); textcolor (yellow);
end;
GotoXY(2,8); begin
if oopt=6 then begin
textbackground (black);
textcolor (green);
end;
Write ('Table of genetic code.');
textbackground (WindowForeColor); textcolor (yellow);
end;
GotoXY(2,9); begin
if oopt=7 then begin
textbackground (black);
textcolor (green);
end;
Write ('Output.');
textbackground (WindowForeColor); textcolor (yellow);
end;
GotoXY(2,10);begin
if oopt=8 then begin
textbackground (black);
textcolor (green);
end;
Write ('Do it !!!');
textbackground (WindowForeColor); textcolor (yellow);
end;
GotoXY(2,11);begin
if oopt=9 then begin
textbackground (black);
textcolor (green);
end;
Write ('Help.');
textbackground (WindowForeColor); textcolor (yellow);
end;
GotoXY(2,12);begin
if oopt=10 then begin
textbackground (black);
textcolor (green);
end;
Write ('Quit.');
textbackground (WindowForeColor); textcolor (yellow);
end;
ReadingKey (kkey, setkey);
case kkey of
UpArrow: begin Dec (oopt); if oopt<1 then oopt:= MaxOptPri; end;
DoArrow: begin Inc (oopt); if oopt>MaxOptPri then oopt:=1; end;
Enter : wwell:= true;
end;
until wwell=true;
case oopt of
1: begin
PointInt^:= PointPant^;
PathReadFile;
if pathch<>Esc then begin flagreadfile:= true; firstime:= false; end
else flagreadfile:= false;
PointPant^:= PointInt^;
window (21, 8, 58, 19);
end;
2: begin
PointInt^:= PointPant^;
careful:= 0;
Repeat
PathWriteFile;
until careful<>3;
PointPant^:= PointInt^;
window (21, 8, 58, 19);
end;
3: begin
PointInt^:= PointPant^;
AskFormat (format);
PointPant^:= PointInt^;
window (21, 8, 58, 19);
end;
4: begin
PointInt^:= PointPant^;
AskMethod (dist);
PointPant^:= PointInt^;
window (21, 8, 58, 19);
end;
5: begin
PointInt^:= PointPant^;
AskWhich (baswhich);
PointPant^:= PointInt^;
window (21, 8, 58, 19);
end;
6: begin
PointInt^:= PointPant^;
AskCodonTableWhich (tablewhich);
PointPant^:= PointInt^;
window (21, 8, 58, 19);
end;
7: begin
PointInt^:= PointPant^;
AskOutput (typeoutput);
PointPant^:= PointInt^;
window (21, 8, 58, 19);
end;
8: begin
PointInt^:= PointPant^;
Presentation;
if ((flagreadfile=true) and (firstime=false)) then
begin
if careful=-1 then
begin
writeln;
writeln (' ¡¡¡ NO FILE FOR OUTPUT !!! ');
writeln;
delay (1500);
end
else
begin
if ((format=1) or (format=2)) then
begin
ReadOptions;
CheckOptions;
end;
FreeList;
case format of
1 : ReadingFileNewPhy (readpath);
2 : ReadingFileOldPhy (readpath);
3 : ReadingFileMSF (readpath);
end;
InitVars;
MakingMatrix;
MakLenghtComMatrix;
MakDistanceMatrix;
if ((baswhich=1) and (tablewhich<>1)) then
begin
ReadingCodonTable (tablewhich);
MakSyn_NonSynMatrix;
end;
assign (writeFile, writePath);
if ((careful=0) or (careful=1)) then Rewrite (writeFile);
if careful=2 then Append (writeFile);
careful:= 2;
WritingResults;
close (writeFile);
end;
end
else
begin
TextColor (Mensaje);
beep (300, 100);
writeln;
writeln (' ¡¡¡ NO FILE TO READ !!! ');
writeln;
delay (1500);
clrscr;
TextColor (WindowTextColor);
end;
PointPant^:= PointInt^;
window (21, 8, 58, 19);
end;
9: begin
PointInt^:= PointPant^;
HelpScreen;
PointPant^:= PointInt^;
window (21, 8, 58, 19);
end;
10: ending:= true;
end;
until ending= true;
textbackground (black);
textcolor (white);
window (1, 1, 80, 25);
clrscr;
CursorOn;
ClrScr;
TheEnd;
end
else (*COMMAND DRIVEN PROGRAM*)
begin
mimodo:= mcomando;
if ((ParamStr(1)='/h') or (ParamStr(1)='/H')) then HelpCommandLine
else begin
writeln;
writeln (' DISTANCE 3.0. 1993 J.A. López Bueno (command mode)');
DoCommandLine;
Inicializa_Ptr;
MakeList;
if ((format=1) or (format=2)) then
begin
ReadOptions;
CheckOptions;
end;
case format of
1 : ReadingFileNewPhy (readpath);
2 : ReadingFileOldPhy (readpath);
3 : ReadingFileMSF (readpath);
end;
InitVars;
MakingMatrix;
MakLenghtComMatrix;
MakDistanceMatrix;
if ((baswhich=1) and (tablewhich<>1)) then
begin
ReadingCodonTable (tablewhich);
MakSyn_NonSynMatrix;
end;
assign (writeFile, writePath);
Rewrite (writeFile);
WritingResults;
close (writeFile);
FreeList;
TheEnd;
end;
end;
END. (*of program*)