Cod sursa(job #798914)

Utilizator elffikkVasile Ermicioi elffikk Data 17 octombrie 2012 16:15:05
Problema Elementul majoritar Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.16 kb
var f1,f2:text;
    a:array[1..1000000]of longint;
    i,n:longint;
    
procedure sw(var x,y:longint);
var t:longint;
begin
  t:=x;
  x:=y;
  y:=t;
end;

function eq(left,right:longint):boolean;
var b:boolean; i:longint;
begin
  b:=true;
  for i:=left+1 to right do
  b:=b and (a[i]=a[i-1]);
  eq:=b;
end;
    
function qs(left,right:longint):longint;
var i,j,pp:longint;
begin
  i:=left;
  j:=right;
  pp:=a[(i+j) div 2];
  while i<j do
  begin
      while a[i]<=pp do inc(i);
      while a[j]>pp do dec(j);
      if i<=j then
      begin
        sw(a[i],a[j]);
        inc(i);
        dec(j);
      end;
  end;
  if right-i+1>n div 2
  then
     if eq(i,right)
     then qs:=a[i]
     else qs:=qs(i,right)
  else
     if j-left+1>n div 2
     then
       if eq(left,j)
       then qs:=a[j]
       else qs:=qs(left,j)
     else qs:=-1;
end;

procedure afis;
var i:longint;
begin
  for i:=1 to n do write(a[i],' ');
  writeln;
end;
    
begin
  assign(f1,'elmaj.in');
  reset(f1);
  readln(f1,n);
  for i:=1 to n do read(f1,a[i]);
  assign(f2,'elmaj.out');
  rewrite(f2);
  writeln(f2,qs(1,n));
  close(f2);
end.