Cod sursa(job #829538)

Utilizator OpportunityVlad Negura Opportunity Data 5 decembrie 2012 16:25:25
Problema Elementul majoritar Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.81 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;
var nr:integer;
 begin
  nr:=0;
  for i:=1 to n do if a[k]=a[i] then inc(nr);
  if (nr>(n div 2)) then writeln(fo,a[k],' ',nr) else writeln(fo,-1);
 end;

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

  citire;
  q(1,n);
  afisare;

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