Cod sursa(job #50745)

Utilizator adrianraduleaRadulea Adrian adrianradulea Data 8 aprilie 2007 16:39:38
Problema Secv Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.63 kb
var f,g:text;
    o:array[1..5000] of longint;
    a:array[1..3,1..500] of longint; {vector de 5000!!!}
    n,k,i,j,lungime,distincte,poz:integer;
    min,max,z:longint;
    stop,ok,ok1:boolean;
procedure ordonare;
begin
for k:=i to j do o[k]:=a[1,k];
repeat
  ok1:=false;
  for k:=i to j-1 do if o[k]>o[k+1] then begin
                                               ok1:=true;
                                               z:=o[k];
                                               o[k]:=o[k+1];
                                               o[k+1]:=z;
                                             end;
until (ok1=false);
end;
begin
assign(f,'secv.in'); reset(f);
assign(g,'secv.out'); rewrite(g);
read(f,n,a[1,1]);
min:=a[1,1];
max:=a[1,1];
for i:=2 to n do begin
  read(f,a[1,i]);
  if a[1,i]>max then max:=a[1,i];
  if a[1,i]<min then min:=a[1,i];
end;
for i:=1 to n do begin
  if a[1,i]=min then begin
    j:=i-1;
    while (j<=n) do begin
      stop:=false;
      while (not stop) and (j<=n) do begin
        inc(j);
        if a[1,j]=max then stop:=true;
      end;
      if a[1,j]=max then begin
        ordonare;
        distincte:=1;
        for k:=i to j-1 do if o[k]<>o[k+1] then inc(distincte);
        if distincte>a[2,i] then begin
          a[2,i]:=distincte;
          a[3,i]:=j-i+1;
        end;
      end;
    end;
  end;
end;
max:=a[2,1]; poz:=1;
for i:=2 to n do begin
  if a[2,i]>max then begin
    poz:=i;
    max:=a[2,i];
  end;
  if a[2,i]=max then
    if a[3,i]>a[3,poz] then poz:=i;
end;
if (a[3,poz]<>0) then write(g,a[3,poz])
                 else write(g,'-1');
close(g);
end.