Как оптимизировать код?

program n_4;
 
function FindI(para1:integer;A1:array of integer;schet:integer):integer;
var p:integer;
begin
  p:=-1;
  for var i:=0 to schet-1 do 
    if para1=A1[i] then
      p := i;
  FindI:=p;
end;
 
function Condition_0(A: integer; exceptions: array of integer; k: integer): boolean;
var
  boo: boolean;
begin
  boo := false;
  for var i := 0 to k - 1 do 
    if (A = exceptions[i])then if A<>0 then boo := true;
  Condition_0 := boo;
end;
 
 
var
  N, M, para1, para2,schet,ID,length,k,p,maxp,t,lya, max: integer;
  A2: array of array of integer;
  A1,X: array of integer;
  s: text;
  exceptions, total: array of integer;
  countManager: array of integer;
 
begin
  
{------------------------------------------------------------------------------------------}
  assign(s, 'input.txt');
  reset(s);
  read(s, N);
  readln(s, M);
  setlength(countManager, n);
  
  setlength(A1,1);
  setlength(A2,1);
  
  schet:=1;
  setlength(countManager,1);
  for var childCount:=0 to m-1 do
  begin
    read(s, para1);
    readln(s, para2);
    ID:=FindI(para1,A1,schet);
    if ID=-1 then 
    begin
      A1[schet-1]:=para1;
      setlength(A1,schet+1);
      setlength(countManager,schet);
      countManager[schet-1]:=2;
      setlength(A2,schet);
      setlength(A2[schet-1],1);
      A2[schet-1,0]:=para2;
      schet:=schet+1;
      end
    else if ID>=0 then
    begin
      length:=countManager[ID];
      setlength(A2[ID],length+1);
      A2[ID,length-1]:=para2;
      countManager[ID]:=countManager[ID]+1;
      end;
      
    ID:=FindI(para2,A1,schet);
    if ID=-1 then 
    begin
      A1[schet-1]:=para2;
      setlength(A1,schet+1);
      setlength(countManager,schet);
      countManager[schet-1]:=2;
      setlength(A2,schet);
      setlength(A2[schet-1],1);
      A2[schet-1,0]:=para1;
      schet:=schet+1;
      end
    else if ID>=0 then
    begin
      length:=countManager[ID];
      setlength(A2[ID],length+1);
      A2[ID,length-1]:=para1;
      countManager[ID]:=countManager[ID]+1;
      end;  
    end;
    
  //   /\                                                                              |\
  //  /  \                                                                             |  \
  //   ||   Это составление матрицы, которая связана с массивом при помощи ID, где ID    \\
  //   ||     показывает какие друзья есть у ученика под номером (организация ввода)      \\
  //   ||                                                                                  \\
  //   ||                                                                                   \\
  //   ||                                                                                    \\
    {---------------------------------------------------------------------------------------}
  
  setlength(total, schet-1);
  
  for var index := 0 to schet-2 do 
  begin
    k := 0;
    p:=0;
    setlength(exceptions, k);  //сброс исключений
    
    for var jndex := 0 to countManager[index] - 2 do
    begin
      setlength(exceptions, k + 1);
      k := k + 1;
      
      exceptions[jndex] := A2[index, jndex];
    end;
    
    {--------------------------} 
    setlength(exceptions, k + 1);
    k := k + 1;
    exceptions[k - 1] := A1[index];
    {--------------------------}
    
    for var jndex := 0 to countManager[index] - 2 do
    begin
      length:=countManager[FindI(A2[index,jndex],A1,schet)];
      for var fndex := 0 to length - 2 do
      begin
        if Condition_0(A2[FindI(A2[index,jndex],A1,schet), fndex], exceptions, k) = false then  //Ищутся друзья друзей, которые не являются исключением
        begin
          setlength(exceptions, k + 1);
          exceptions[k] := A2[FindI(A2[index,jndex],A1,schet), fndex];
          k := k + 1;
          p := p + 1;
        end;
      end;
      
      total[index] := p+countManager[index]-1;
      if maxp<total[index] then
        maxp:=total[index];
    end;
  end;
  {--------------------------------------------}
 
  write(maxp,' ');
  
  lya:=0;
  for var i := 0 to schet-2 do
    if maxp = total[i] then
    begin
      t := t + 1;
      setlength(x,lya+1);
      x[lya]:=A1[i];
      lya:=lya+1;
      end;
  writeln(t);
  
  for var i := 1 to lya-1 do
        for var j := 0 to lya-i-1 do
            if x[j] > x[j+1] then 
              begin
                t := x[j];
                x[j] := x[j+1];
                x[j+1] := t
            end;
    
  for var i:=0 to lya-1 do
    write(x[i],' ')
  end.