Cod sursa(job #43587)

Utilizator savimSerban Andrei Stan savim Data 30 martie 2007 12:05:22
Problema Secv Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.93 kb
var f1,f2:text;
    b,poz,a:array[1..5000] of longint;
    min,p,q,m,n,aa,gas,x,i,j,ok:longint;
begin
assign(f1,'secv.in');
assign(f2,'secv.out');
reset(f1);
rewrite(f2);
readln(f1,n);
for i:=1 to n do
 read(f1,a[i]);
m:=1;b[m]:=a[1];
for i:=2 to n do
 begin
  gas:=0;
  for j:=1 to m do
   if b[j]=a[i] then begin gas:=1;break;end;
  if gas=0 then begin m:=m+1;b[m]:=a[i];end;
 end;
for i:=1 to m-1 do
 for j:=i+1 to m do
  if b[i]>b[j] then
   begin
    x:=b[i];
    b[i]:=b[j];
    b[j]:=x;
   end;
q:=0;
for i:=1 to n do
 if a[i]=b[1] then begin q:=q+1;poz[q]:=i;end;

min:=5000;
for i:=1 to q do
 begin
  p:=poz[i];ok:=1;aa:=p;
  for j:=2 to m do
   begin
    gas:=0;
    for x:=p to n do
     if a[x]=b[j] then begin gas:=1;p:=x;break;end;
    if gas=0 then begin ok:=0;break;end;
   end;
  if ok=1 then
           if p-aa+1<min then min:=p-aa+1;
 end;
writeln(f2,min);
close(f1);
close(f2);
end.