Cod sursa(job #829341)

Utilizator elffikkVasile Ermicioi elffikk Data 5 decembrie 2012 08:37:01
Problema Elementul majoritar Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.08 kb
var a:array[1..1000000]of longint;
  n,k,nk:longint;
  f1,f2:text;

procedure init;
var i:longint;
begin
  assign(f1, 'elmaj.in');
  reset(f1);
  readln(f1,n);
  for i:=1 to n do read(f1, a[i]);
end;

procedure afis;
var i:longint;
begin
  for i:=1 to n do write(a[i],' '); writeln;
end;

procedure swap(var x,y:longint);
var t:longint;
begin
  t:=x; x:=y; y:=t;
end;

procedure qs(left, right:longint);
var i,j,pp:longint;
begin  
  i:=left; j:=right; pp:=a[i+random(j-i+1)];
  while i<j do
  begin
    while a[i]<pp do inc(i);
    while a[j]>pp do dec(j);
    if i<=j then begin swap(a[i], a[j]); inc(i); dec(j); end;
  end;
  if (i<right)and(i<=k)and(k<=right) then qs(i, right);
  if (left<j)and(left<=k)and(k<=j) then qs(left, j);
end;

function count(v:longint):longint;
var i,k:longint;
begin
  k:=0;
  for i:=1 to n do if a[i]=v then inc(k);
  count:=k;
end;

begin
  randomize;
  init;
  k:=n div 2;
  {afis;}
  qs(1,n);
  {afis;}
  nk:=count(a[k]);
  assign(f2,'elmaj.out');
  rewrite(f2);
  writeln(f2,a[k],' ',nk);
  close(f2);
end.