Cod sursa(job #829530)

Utilizator OpportunityVlad Negura Opportunity Data 5 decembrie 2012 16:21:29
Problema Elementul majoritar Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.75 kb
var a:array[1..10000]of integer;
    n,i,k:longint;
    fi,fo:text;

procedure citire;
 begin
  readln(fi,n);
  k:=n div 2;
  for i:=1 to n do read(fi,a[i]);
 end;

procedure q(l,r:longint);
var aux,i,j,p:longint;
 begin
  i:=l; j:=r; p:=a[(i+j) div 2];
  while (i<j) do
   begin
    while a[i]<p do inc(i);
    while a[j]>p do dec(j);
    if i<=j then begin aux:=a[i]; a[i]:=a[j]; a[j]:=aux; inc(i); dec(j); end;
   end;
  if (k<=i)and(l<j) then q(l,j) else if (i<r) then q(i,r);
 end;

procedure afisare;
 begin
  for i:=1 to n do write(fo,a[i],' ');
  writeln(fo);
  writeln(fo,a[k]);
 end;

BEGIN
 assign(fi,'q.in'); reset(fi);
 assign(fo,'q.out'); rewrite(fo);

  citire;
  q(1,n);
  afisare;

 close(fi); close(fo);
END.