Cod sursa(job #1652472)

Utilizator medicinedoctoralexandru medicinedoctor Data 14 martie 2016 23:19:57
Problema Elementul majoritar Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.06 kb
var a:array [1..1000000] of real;
n:longint; q:real;

procedure lire;
var i:longint;    f:text;
begin
  assign(f,'elmaj.in');
  reset(f);
  read(f,n);
  for i:=1 to n do
  read(f,a[i]);
  close(f);
end;

procedure sw(var x,y:real);
var q:real;
begin
  q:=x;
  x:=y;
  y:=q;
end;

procedure qs(l,r:longint);
var i,j:longint; q:real;
begin
  i:=l; j:=r; q:=a[(i+j) div 2];
  while (i<j) do
  begin
    while (a[i]<q) do i:=i+1;
    while (a[j]>q) do j:=j-1;
    if (i<=j) then
      begin
        sw(a[i],a[j]);
        i:=i+1;
        j:=j-1;
      end;
  end;
  if (i<r) then qs(i,r);
  if (j>l) then qs(l,j);
end;

function lu:longint;
var i,x,y:longint; r:real;
begin
  x:=1; r:=a[1]; y:=0;
  for i:=2 to n do
  if a[i]=r then x:=x+1 else begin if x>y then begin y:=x; q:=r; end; x:=1; r:=a[i]; end;
  lu:=y;
end;

procedure ecrire(x:longint);
var f:text;
begin
  assign(f,'elmaj.out');
  rewrite(f);
  if x>(n div 2) then write(f,q,' ',x) else write(f,-1);
  close(f);
end;

begin
  lire;
  qs(1,n);
  ecrire(lu);
end.