Cod sursa(job #47397)

Utilizator QbyxEros Lorand Qbyx Data 3 aprilie 2007 17:31:42
Problema Stramosi Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.74 kb
var
  Osok: array[1..19,1..250000] of longint;
  f, g: text;
  n, n2, m, i, j, a, b, akt, k: longint;
  ketto: array[1..20] of longint;

function KettoH(a: longint): byte;
begin
  case a of
    3..3: begin KettoH := 2; Exit; end;
    4..7: begin KettoH := 3; Exit; end;
    8..15:begin KettoH := 4; Exit; end;
    16..63: begin KettoH := 5; Exit; end;
    64..127: begin KettoH := 6; Exit; end;
    128..255: begin KettoH := 7; Exit; end;
    258..511: begin KettoH := 8; Exit; end;
    512..1023: begin KettoH := 9; Exit; end;
    1024..2047: begin KettoH := 10; Exit; end;
    2048..4195: begin KettoH := 11; Exit; end;
    4196..8391: begin KettoH := 12; Exit; end;
    8392..16783: begin KettoH := 13; Exit; end;
    16784..33567: begin KettoH := 14; Exit; end;
    33568..67135: begin KettoH := 15; Exit; end;
    67136..134271: begin KettoH := 16; Exit; end;
    134272..268543: begin KettoH := 17; Exit; end;
    268544..537087: begin KettoH := 18; Exit; end;
  else KettoH := a;
  end;
end;

begin
  Assign(f, 'stramosi.in');
  Assign(g, 'stramosi.out');
  Reset(f);
  ReWrite(g);

  ReadLn(f, n, m);

  ketto[1] := 1; for i := 2 to 20 do ketto[i] := ketto[i-1] * 2;

  n2 := KettoH(n);

  for i := 1 to n do
    begin
      Read(f, a);
      Osok[1,i] := a;
    end;

  for j := 2 to n2 do
    for i := 1 to n do
      if Osok[j - 1,i] <> 0 then Osok[j,i] := Osok[j - 1, Osok[j - 1,i]];

  for i := 1 to m do
    begin
      ReadLn(f, a, b);
      n := 19;
      k := b;
      akt := a;

      while (k <> 0) and (akt <> 0) do
        begin
          n:= KettoH(k);
          akt := Osok[n,akt];
          k := k - ketto[n];
        end;

      WriteLn(g, akt);
    end;
  Close(f);
  Close(g);
end.