Cod sursa(job #73112)

Utilizator mlazariLazari Mihai mlazari Data 16 iulie 2007 20:04:40
Problema Fractal Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.03 kb
Program Fractal;
var p2 : array[0..30] of longint;
    k : integer;
    x,y : longint;

procedure Citeste;
var Intrare : text;
begin
  assign(Intrare,'fractal.in');
  reset(Intrare);
  read(Intrare,k,x,y);
  close(Intrare);
end;

procedure CalculeazaPuterileLui2;
var i : integer;
begin
  p2[0]:=1;
  for i:=1 to 30 do p2[i]:=p2[i-1]*2;
end;

function S(k : integer; x,y : longint) : longint;
var caz : integer;
begin
  if x<=p2[k-1] then
   begin
     if y<=p2[k-1] then caz:=1 else caz:=2;
   end
   else
    begin
      if y<=p2[k-1] then caz:=4 else caz:=3;
    end;
  if k=1 then S:=caz-1
   else
    case caz of
      1: S:=S(k-1,y,x);
      2: S:=p2[2*k-2]+S(k-1,x,y-p2[k-1]);
      3: S:=p2[2*k-1]+S(k-1,x-p2[k-1],y-p2[k-1]);
      4: S:=3*p2[2*k-2]+S(k-1,p2[k-1]-y+1,p2[k]-x+1);
    end;
end;

procedure Scrie;
var Iesire : text;
begin
  assign(Iesire,'fractal.out');
  rewrite(Iesire);
  write(Iesire,S(k,x,y));
  close(Iesire);
end;

begin
  Citeste;
  CalculeazaPuterileLui2;
  Scrie;
end.