COIN34 - 34 đồng xu

Tác giả: ll931110

Ngôn ngữ: Pascal

program coin34;
const
  input  = '';
  output = '';
  maxk = 250000;
  maxn = 34;
  slot = 19;
  maxt = 1 shl (maxn - slot);
var
  fi,fo: text;
  i,nTest: longint;
  a: array[1..maxn] of longint;
  low: array[0..maxk] of longint;
  list: array[1..maxn] of longint;
  b1,b2: array[0..maxt] of longint;
  nb: longint;
  ss,sw: longint;

procedure openfile;
begin
  assign(fi, input);
    reset(fi);

  assign(fo, output);
    rewrite(fo);
end;

procedure closefile;
begin
  close(fo);
  close(fi);
end;

procedure att(i: longint);
var
  j: longint;
begin
  for j := 0 to 1 do
    begin
      list[i] := j;
      if j = 1 then
        begin
          ss := ss + a[i];
          inc(sw);
        end;

      if i = slot then
        begin
          if low[ss] < sw then low[ss] := sw;
        end
      else att(i + 1);

      if list[i] = 1 then
        begin
          ss := ss - a[i];
          dec(sw);
        end;
    end;
end;

procedure att2(i: longint);
var
  j: longint;
begin
  for j := 0 to 1 do
    begin
      list[i] := j;
      if j = 1 then
        begin
          ss := ss + a[i];
          inc(sw);
        end;

      if i = maxn then
        begin
          inc(nb);
          b1[nb] := ss;
          b2[nb] := sw;
        end
      else att2(i + 1);

      if list[i] = 1 then
        begin
          ss := ss - a[i];
          dec(sw);
        end;
    end;
end;

procedure ext(var x,y: longint);
var
  z: longint;
begin
  z := x;  x := y;  y := z;
end;

procedure swap(i,j: longint);
begin
  ext(b1[i],b1[j]);  ext(b2[i],b2[j]);
end;

procedure sort(l,h: longint);
var
  i,j,p: longint;
begin
  if l >= h then exit;
  i := l;  j := h;  p := b1[random(h - l + 1) + l];

  repeat
    while b1[i] < p do inc(i);
    while b1[j] > p do dec(j);

    if i <= j then
      begin
        if i < j then swap(i,j);
        inc(i);
        dec(j);
      end;
  until i > j;

  sort(l,j);  sort(i,h);
end;

procedure precom;
var
  i: longint;
begin
  fillchar(low, sizeof(low), 0);
  a[1] := 2;  a[2] := 3;  a[3] := 5;

  for i := 4 to maxn do a[i] := a[i - 1] + a[i - 2] + a[i - 3];

  ss := 0;
  sw := 0;
  att(1);

  nb := -1;
  att2(slot + 1);
  sort(0,nb);
end;

procedure solve;
var
  i,x: longint;
  t1,t2: longint;
  k1: longint;
  inf,sup,med: longint;
  res: longint;
begin
  readln(fi, x);
  res := -1;

  inf := 0;
  sup := nb;
  repeat
    med := (inf + sup) div 2;
    if b1[med] <= x then
      begin
        t2 := med;
        inf := med + 1;
      end
    else sup := med - 1;
  until inf > sup;

  inf := 0;
  sup := nb;
  repeat
    med := (inf + sup) div 2;
    if b1[med] >= x - maxk then
      begin
        t1 := med;
        sup := med - 1;
      end
    else inf := med + 1;
  until inf > sup;

  for i := t1 to t2 do
    begin
      k1 := x - b1[i];
      if ((k1 = 0) or (low[k1] <> 0)) and (res < b2[i] + low[k1])
        then res := b2[i] + low[k1];
    end;

  writeln(fo, res);
end;

begin
  openfile;
  precom;

  readln(fi, nTest);
  for i := 1 to nTest do
    begin
      write(fo, 'Case #', i, ': ');
      solve;
    end;

  closefile;
end.

Download