рекурсивный подъем и...

Program LAB3;
uses crt;
const n=5; {количество слов в файле}
type mas=array[1..n] of string[25];
var file1:text;
    str:string;
    box:mas;
    w:integer;
 
Procedure READING(var f1:text;var a:mas);
var s:string;
    i,k,j:integer;
Begin
  assign(f1,'3.txt');
  reset(f1);
  readln(f1,s);
  writeln(s);
  writeln;
  i:=1; j:=1;
  repeat
    k:=1;
    while ((i<=length(s)) and (s[i]<>',') and (s[i+1]<>' ')) do
      begin
        inc(i);  inc(k);
      end;
    a[j]:=copy(s,i-(k-1),k-1);
    inc(i);  inc(j);
  until i>length(s);
End;
 
Function GLUBINA(q:mas):integer;
var i,j:integer;
Begin
  i:=0;
  for j:=1 to length(q[3]) do
    if (q[3,j]=q[n,length(q[n])]) then i:=i+1;
    GLUBINA:=i;
End;
 
Procedure SPUSK(c:mas; p:integer);
var i:integer;
Begin
  if p>GLUBINA(c) then
    begin
      if c[3,p]=c[n,length(c[n])] then
        begin
          delete(c[3],pos(c[n,length(c[n])],c[3]),1);
          writeln(c[3]);
        end;
      SPUSK(c,p-1);
    end;
End;
 
Procedure UP(e:mas; t:integer);
var i:integer;
Begin
  if t>0 then
  begin
    UP(e,t-1);
    if e[3,t]=e[n,length(e[n])] then
      begin
        delete(e[3],pos(e[n,length(e[n])],e[3]),1);
        writeln(e[3],t);
      end;
  end;
End;
 
Procedure USUAL(b:mas;k:integer);
var i:integer;
Begin
  i:=1;
  while i<k do
  begin
    if b[3,i]=b[n,length(b[n])] then
      begin
        delete(b[3],i,1);
        writeln(b[3]);
      end
    else inc(i);
  end;
End;
 
BEGIN
  clrscr;
  textcolor(WHITE);
  READING(file1,box);
  readkey;
  window(5,2,25,25);
  textcolor(10);
  writeln('Рекуксивный спуск:');
  SPUSK(box,length(box[3]));
  writeln;
  readkey;
  window(26,2,50,25);
  textcolor(14);
  writeln('Рекуксивный подъём:');
  UP(box,length(box[3])-1);
  readkey;
  window(51,2,80,25);
  textcolor(5);
  writeln('Без рекурсии:');
  w:=length(box[3]);
  USUAL(box,w);
  readkey;
END.