Cod sursa(job #93835)

Utilizator corneliuLungociu Corneliu corneliu Data 20 octombrie 2007 14:13:33
Problema Secventa Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.31 kb
type leg=^el;
     el=record p,u:leg;
               x:integer;
               baza:boolean;
        end;
     sir=array[1..500]of integer;
var a:sir;
    p,u:leg;
    n,k:integer;

procedure citire;
var i:integer;
begin
  assign(input,'secventa.in');
  reset(input);
  readln(n,k);
  for i:=1 to n do
    read(a[i]);
  close(input);
end;

procedure adauga(x:integer; var p,u:leg);
var q:leg;
begin
  new(q);
  q^.x:=x;
  q^.p:=u;
  q^.u:=nil;
  q^.baza:=false;
  if p=nil then p:=q
           else u^.u:=q;
  u:=q;
end;

procedure adauga_fara(x:integer; var p,u:leg);
var q,nou:leg;
begin
  q:=u;
  while (q<>nil)and(a[q^.x]>=a[x]) do
    q:=q^.p;
  if q=nil then begin new(q);
                      q^.x:=x;
                      q^.u:=p;
                      q^.p:=nil;
                      q^.baza:=false;
                      p:=q;
                 end
             else
                 if q=u then adauga(x,p,u)
                        else
                          begin
                            new(nou);
                            nou^.x:=x;
                            nou^.u:=q^.u;
                            nou^.p:=q;
                            nou^.p^.u:=nou;
                            nou^.u^.p:=nou;
                            nou^.baza:=false;
                          end;
end;

procedure  adauga_sterge(x:integer; var p,u:leg; var nr:integer; var baza:boolean);
var nou,q:leg;
begin
  q:=u;
  nr:=0;
  baza:=false;
  while (q<>nil)and(a[q^.x]>=a[x]) do
    begin
      if q^.baza=true then baza:=true;
      q:=q^.p;
      nr:=nr+1;
    end;
  if nr=0 then begin adauga(x,p,u);
                     exit;
               end
          else
            begin
              new(nou);
              nou^.x:=x;
              nou^.p:=q;
              nou^.u:=nil;
              q^.u:=nou;
              u:=nou;
            end;
end;

procedure compara(var x,y:integer);
begin
 if a[x]>a[y] then y:=x;
end;


function calcul:integer;
var xmax,baza_max,i,j,nr:integer;
    baza,gasit:boolean;
    q:leg;

begin
 p:=nil;
 u:=nil;
 adauga(1,p,u);
 for i:=2 to k-1 do
     adauga_fara(i,p,u);
 xmax:=p^.x;
 p^.baza:=true;
 for i:=k to n do
   begin
    adauga_sterge(i,p,u,nr,baza);
    if (nr>=(k-1))or
       ((nr>0)and(baza))
                 then begin u^.baza:=true;
                            compara(u^.x,xmax);
                      end
                 else
                   begin q:=u;
                         for j:=1 to (k-1)-nr do
                           begin
                             q:=q^.p;
                             if q^.baza then
                                            break;

                           end;
                         q^.baza:=true;
                         if a[q^.x]>a[baza_max] then begin xmax:=u^.x;
                                                           baza_max:=q^.x;
                                                     end;

{                         compara(q^.x,xmax);          }
                   end;
   end;
 calcul:=xmax;
end;

procedure afisare(x:integer);
var i:integer;
begin
  assign(output,'secventa.out');
  rewrite(output);
  for i:=x downto x-k+1 do
    write(a[i],' ');
  close(output);
end;

begin
  citire;
  afisare(calcul);
end.