Cod sursa(job #64597)

Utilizator FreeYourMindAndrei FreeYourMind Data 4 iunie 2007 15:05:58
Problema Fractal Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.08 kb
// by Freemind
// website: http://freeyourminder.spaces.live.com
// e-mail:  [email protected]

program fractal;

const fin = 'fractal.in';
     fout = 'fractal.out';

var k: byte;
  x,y: longint;
   _2: array[0..16] of longint;
moves: longint;

procedure load;
 var f: text;
begin
 assign(f, fin); reset(f);
  readln(f, k, y, x);
 close(f);
end;

procedure fill_2;
 var i: byte;
begin
 _2[0]:=1;
 for i:=1 to 16 do
  _2[i]:=2*_2[i-1];
end;

function getquarter(k,x,y: longint): byte;
begin
 if (x<=_2[k-1]) and (y<=_2[k-1])
    then begin
              getquarter:=1;
              exit;
         end;
 if (x<=_2[k]) and (y<=_2[k-1])
    then begin
              getquarter:=2;
              exit;
         end;
 if (x>_2[k-1]) and (y>_2[k-1])
    then begin
              getquarter:=3;
              exit;
         end;
 getquarter:=4;
end;

procedure solve;
 var q: byte; temp:longint;
begin
 moves:=0;
 while k>1 do
  begin
       q:=getquarter(k,x,y);
       if q=1 then begin temp:=x; x:=y; y:=temp; end;
       if q=2 then begin
                        moves:=moves+_2[2*k-2];
                        x:=x-_2[k-1];
                        temp:=x; x:=y; y:=temp;
                   end;
       if q=3 then begin
                        moves:=moves+_2[2*k-1];
                        x:=x-_2[k-1];
                        y:=y-_2[k-1];
                        temp:=x; x:=y; y:=temp;
                   end;
       if q=4 then begin
                        moves:=moves+_2[2*k-1]+_2[2*k-2];
                        y:=y-_2[k-1];
                        x:=_2[k-1]+1-x;
                        y:=_2[k-1]+1-y;
                   end;
       dec(k);
  end;
  if k=1 then
     begin
      if (x=1) and (y=1) then ;
      if (x=1) and (y=2) then inc(moves);
      if (x=2) and (y=2) then inc(moves,2);
      if (x=2) and (y=1) then inc(moves,3       );
     end;
end;

procedure save;
 var f: text;
begin
 assign(f, fout); rewrite(f);
 write(f, moves);
 close(f);
end;

begin
 load;
 fill_2;
 solve;
 save;
end.