Cod sursa(job #555851)

Utilizator ion_calimanUAIC Ion Caliman ion_caliman Data 15 martie 2011 20:08:35
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.66 kb
var     a:array[1..2,1..100000]of longint;
        b:array[1..100000] of boolean;
        n,m,x,y:longint;
        i,j:longint;
        f1,f2:text;

procedure sw(var a,b:longint);
var     t:longint;
begin
  t:=a; a:=b; b:=t;
end;

procedure qs1(left,right:longint);
var     i,j,r:longint;
begin
  i:=left;
  j:=right;
  r:=a[1,(i+j) div 2];
  while i<j do
    begin
      while a[1,i]<r do inc(i);
      while a[1,j]>r do dec(j);
      if i<=j then
        begin
          sw(a[1,i],a[1,j]);
          sw(a[2,i],a[2,j]);
          inc(i);
          dec(j);
        end;
    end;
  if i<right then qs1(i,right);
  if j>left then qs1(left,j);
end;

procedure qs(left,right:longint);
var     i,j,r:longint;
begin
  i:=left;
  j:=right;
  r:=a[2,(i+j) div 2];
  while i<j do
    begin
      while a[2,i]<r do inc(i);
      while a[2,j]>r do dec(j);
      if i<=j then begin sw(a[2,i],a[2,j]); inc(i); dec(j); end;
    end;
  if i<right then qs(i,right);
  if j>left then qs(left,j);
end;

begin
  assign(f1,'sortaret.in');
  assign(f2,'sortaret.out');
  reset(f1);
  rewrite(f2);
  readln(f1,n,m);
  for i:=1 to m do
    begin
      readln(f1,x,y);
      if x<y then
        begin
          a[1,i]:=x;
          a[2,i]:=y;
        end
      else
        begin
          a[1,i]:=y;
          a[2,i]:=x;
        end;
    end;

  qs1(1,m);

  i:=1;
  while i<m do
    begin
      j:=i;
      while a[1,j+1]=a[1,i] do inc(j);
      qs(i,j);
      i:=j+1;
    end;


  i:=1;
  j:=1;
  while (i<m)and(j<m) do
    begin
      {while a[1,i]<=a[2,j] do
        begin
          if not b[a[1,i]] then
            begin
              b[a[1,i]]:=true;
              write(f2,a[1,i],' ');
            end;
          inc(i);
        end;}
      if a[1,i]<=a[2,j] then
        begin
          if not b[a[1,i]] then
            begin
              b[a[1,i]]:=true;
              write(f2,a[1,i],' ');
            end;
          inc(i);
        end;
      if a[1,i]>a[2,j] then
        begin
          if not b[a[2,j]] then
            begin
              b[a[2,j]]:=true;
              write(f2,a[2,j],' ');
            end;
          inc(j);
        end;
    end;
  while i<=m do
    begin
      if not b[a[1,i]] then
            begin
              b[a[1,i]]:=true;
              write(f2,a[1,i],' ');
            end;
          inc(i);
    end;
  while j<=m do
    begin
      if not b[a[2,j]] then
            begin
              b[a[2,j]]:=true;
              write(f2,a[2,j],' ');
            end;
          inc(j);
    end;

  for i:=1 to n do
    if not b[i] then write(f2,i,' ');
  close(f2);
end.