How write answer fast?

In my program i get array[1..2, 1..n] - array of rid in graph. And write answer in O(3*N^2) - that very big.

My program:
var a,b : array [1..7501] of word;
    p   : array [1..2, 1..7501] of word;
    ans : array [1..7501] of boolean;
    i,j,k,n,x : longint;

BEGIN
  n := 0;
  while not eof do
  begin
    read(x);
    inc(n); a[n] := x;
    inc(b[x]);
  end;

  for i := 1 to n do
  begin
    j := 1;
    while (b[j] <> 0) do inc(j);

    dec(b[a[i]]); b[j] := 65535;

    p[1, i] := a[i]; p[2, i] := j;
  end;

  for i := 1 to n+1 do
  begin
    fillchar(ans, sizeof(ans), 0);

    for k := 1 to n do
    for j := 1 to 2 do
      if p[j, k] = i then ans[p[3-j, k]] := true;

    write(i,':');
    for j := 1 to n+1 do
      if ans[j] then write(' ',j);
    writeln;
  end;
END.

Edited by author 05.06.2004 09:37