program tally;
type
stringsegment=record
seg:ansistring;
pos:int32;
lngth:int32;
end;
Type
intArray = Array of int32;
segarray = array of stringsegment;
// ========= number of partstring in somestring =============//
function tally(somestring:pchar;partstring:pchar;var arr: intarray ):int32;
var
i,j,ln,lnp,count,num:integer ;
filler:boolean;
label
skip ,start,return;
begin
ln:=length(somestring);
lnp:=length(partstring);
filler:=false;
start:
count:=0;
i:=-1;
repeat
i:=i+1;
if somestring[i] <> partstring[0] then goto skip ;
if somestring[i] = partstring[0] then
begin
for j:=0 to lnp-1 do
begin
if somestring[j+i]<>partstring[j] then goto skip;
end;
count:=count+1;
if filler = true then arr[count]:=i+1 ;
i:=i+lnp-1;
end ;
skip:
until i>=ln-1 ;
SetLength(arr,count); // size is now known, repeat the operation to fil arr
arr[0]:=count; // save tally in [0]
num:=count;
if filler=true then goto return;
filler:=true;
goto start;
return:
result:=num;
end; {tally}
procedure dubblesort(var arr :array of stringsegment);
var
n1,n2:int32;
temp:stringsegment;
begin
for n1:=low(arr) to high(arr)-1 do
begin
for n2:=n1+1 to high(arr) do
begin
if length(arr[n1].seg) > length(arr[n2].seg) then
begin
temp:=arr[n1];
arr[n1]:=arr[n2];
arr[n2]:=temp;
end;
end;
end;
// now sort the start pos
for n1:=low(arr) to high(arr)-1 do
begin
for n2:=n1+1 to high(arr) do
begin
if ((length(arr[n1].seg) = length(arr[n2].seg)) and (arr[n1].pos > arr[n2].pos)) then
begin
temp:=arr[n1];
arr[n1]:=arr[n2];
arr[n2]:=temp;
end;
end;
end;
end;
procedure getsegments(s:ansistring;first:ansistring;second:ansistring;var segs:segarray);
var
p:pchar;
arr,arr2: array of integer;
i,j,diff,counter,t2:int32;
label
lbl;
begin
counter:=0;
diff:=0;
p:=pchar(s);
tally(p,pchar(first),arr);
tally(p,pchar(second),arr2);
for i:=1 to arr[0] do
for j:=1 to arr2[0] do
begin
begin
if ((i>arr[0]) or (j>arr2[0])) then goto lbl; // outwith bounds.
diff:= abs(arr[i]-arr2[j]);
t2:=pos(second,s[arr[i] .. arr2[j]]);
if (( diff mod 3=0) and (arr[i] < arr2[j])) and (t2=0) then
begin
setlength(segs,counter+1);
segs[counter].seg:=s[arr[i] .. arr2[j]+2];
segs[counter].pos:=arr[i];
segs[counter].lngth:=length(segs[counter].seg);
counter:=counter+1;
end;
end ;
end;
lbl:
dubblesort(segs);
end;
//=========== Use =========== //
var
arr,arr2:intarray;
p:pchar;
s,s1,s2,s3:ansistring;
i,j,num,diff,lastlength:int32;
segs:array of stringsegment;
label
lbl;
begin
s1:='ACTGCTAATGATTTGGACTTGGTAGCGTTACCTG';
s:= 'ACTGCTAATGATTTGGAATTTGGACTTGGTAGCGTTACCTG';
s2:='ACTGCTAATGATTTGGACTTTGGAATTTGGACTTGGGTAGCGTTACCTG';
s3:='ACTGCTAATGATTTGGACTTGGACTTGGTAGCGTTACCTG';
for i:=1 to 70 do
begin
s:=(s1+s2+s3+s);
end;
writeln ('The string');
writeln(s);
writeln('Length = ',length(s));
writeln;
getsegments(s,'ATG','TAG',segs);
for i:=low(segs) to high(segs) do
begin
if ( length(segs[i].seg) < 100 ) then
write(segs[i].seg,' [start = ':5,segs[i].pos:4,', length = ',segs[i].lngth,']');
if ( length(segs[i].seg) >= 100 ) then
begin
if (lastlength <> length(segs[i].seg)) then writeln;
write('. . . [start = ':5,segs[i].pos:4,', length = ',segs[i].lngth,']');
end;
lastlength:= length(segs[i].seg);
writeln;
end;
writeln;
writeln('Press enter to end');
readln;
end.