Cele mai bune solutii pentru problema "La monetarie"
(ziua2, problema5)


Punctaj Maxim : 50 puncte

Solutii :
Toda Catalin- Bihor
Comisia Centrala
Fisierele de teste


Program realizat de elevul Toda Catalin - rezultat final : mentiune - 81 puncte

uses crt;
type tab=array[1..3]of word;
var a:tab;i,j,k,m,n:integer;b,l:array[0..8000]of record i,j:integer; end;
    f1,f2:text;
procedure tipar(k1:integer);
begin
if k1<k then begin
   k:=k1;
   l:=b;
             end;
end;

procedure rec(a:tab;i,j,k:integer);
var i1,j1:integer;
begin
if k<>1 then begin
                         a[i]:=a[i]-a[j];
                         a[j]:=a[j]*2;
                         b[k].i:=i;
                         b[k].j:=j;end;
if (a[1]=0)or(a[2]=0)or(a[3]=0) then tipar(k);
if k<=11 then begin
    for i1:=1 to 3 do
        for j1:=1 to 3 do if (i1<>j1)and(a[i1]>=a[j1]) then begin
                         rec(a,i1,j1,k+1);

                                                      end;
             end;
end;
begin
clrscr;
assign(f1,'saci.in');
assign(f2,'saci.out');
reset(f1);
rewrite(f2);
k:=maxint;
readln(f1,a[1],a[2],a[3]);
rec(a,1,1,1);
if k<>maxint then begin
writeln(f2,k-1);
for I:=2 to k do
writeln(f2,l[i].i,' ',l[i].j);end else writeln(f2,'0');
close(f1);
close(f2);
end.

[BACK]


Program realizat de Comisia Centrala a Olimpiadei Nationale de Informatica

{Rezolvare propusa de comisie - implementata de Valentin Gheorghita}
type ref=^inr;
     inr=record
          dr,tata:ref;
          a,b,c:integer;
         end;

var a,b,c,pz:integer;
    f:text;
    final,temp,rad,poz,caut:ref;
    mut:array[1..300,1..3] of integer;

function minim(a,b,c,pz:integer):integer;
 var t:integer;
 begin
  if a>b then begin t:=a; a:=b; b:=t; end;
  if a>c then begin t:=a; a:=c; c:=t; end;
  if b>c then begin t:=c; c:=b; b:=t; end;
  case pz of
   1 : minim:=a;
   2 : minim:=b;
   3 : minim:=c;
   end;
 end;

procedure initializare;
 begin
  new(rad);
  new(temp);
  rad^.dr:=temp;
  temp^.dr:=nil;
  temp^.tata:=nil;
  temp^.a:=minim(a,b,c,1);
  temp^.b:=minim(a,b,c,2);
  temp^.c:=minim(a,b,c,3);
  poz:=rad;
  final:=temp;
 end;

procedure citire;
 begin
  assign(f,'saci.in');
  reset(f);
  readln(f,a,b,c);
  close(f);
 end;

function verif:boolean;
 var test:boolean;
 begin
  test:=false;
  if final^.a=final^.b then begin
                             test:=true;
                             mut[1,1]:=0;
                             mut[1,2]:=b+a;
                             mut[1,3]:=c;
                             pz:=1;
                            end;
  if final^.a=final^.c then begin
                             test:=true;
                             mut[1,1]:=0;
                             mut[1,2]:=b;
                             mut[1,3]:=c+a;
                             pz:=1;
                            end;
  if final^.b=final^.c then begin
                             test:=true;
                             mut[1,1]:=a;
                             mut[1,2]:=b+b;
                             mut[1,3]:=0;
                             pz:=1;
                            end;
  verif:=test;
 end;

procedure cautare;
 label 10;
 var test:boolean;
 begin
  if verif then goto 10;
  repeat
   poz:=poz^.dr;
   a:=minim(poz^.a+poz^.a,poz^.b-poz^.a,poz^.c,1);
   b:=minim(poz^.a+poz^.a,poz^.b-poz^.a,poz^.c,2);
   c:=minim(poz^.a+poz^.a,poz^.b-poz^.a,poz^.c,3);
   test:=true;
   temp:=rad;
   repeat
    temp:=temp^.dr;
    if (temp^.a=a) and (temp^.b=b) and (temp^.c=c) then test:=false
   until (temp^.dr=nil) or not(test);
   if test then begin
                 new(temp);
                 temp^.tata:=poz;
                 temp^.a:=a;
                 temp^.b:=b;
                 temp^.c:=c;
                 temp^.dr:=nil;
                 final^.dr:=temp;
                 final:=temp;
                 if verif then goto 10;
                end;
   a:=minim(poz^.a+poz^.a,poz^.b,poz^.c-poz^.a,1);
   b:=minim(poz^.a+poz^.a,poz^.b,poz^.c-poz^.a,2);
   c:=minim(poz^.a+poz^.a,poz^.b,poz^.c-poz^.a,3);
   test:=true;
   temp:=rad;
   repeat
    temp:=temp^.dr;
    if (temp^.a=a) and (temp^.b=b) and (temp^.c=c) then test:=false
   until (temp^.dr=nil) or not(test);
   if test then begin
                 new(temp);
                 temp^.tata:=poz;
                 temp^.a:=a;
                 temp^.b:=b;
                 temp^.c:=c;
                 temp^.dr:=nil;
                 final^.dr:=temp;
                 final:=temp;
                 if verif then goto 10;
                end;
   a:=minim(poz^.a,poz^.b+poz^.b,poz^.c-poz^.b,1);
   b:=minim(poz^.a,poz^.b+poz^.b,poz^.c-poz^.b,2);
   c:=minim(poz^.a,poz^.b+poz^.b,poz^.c-poz^.b,3);
   test:=true;
   temp:=rad;
   repeat
    temp:=temp^.dr;
    if (temp^.a=a) and (temp^.b=b) and (temp^.c=c) then test:=false
   until (temp^.dr=nil) or not(test);
   if test then begin
                 new(temp);
                 temp^.tata:=poz;
                 temp^.a:=a;
                 temp^.b:=b;
                 temp^.c:=c;
                 temp^.dr:=nil;
                 final^.dr:=temp;
                 final:=temp;
                 if verif then goto 10;
                end;

  until false;
  10:
 end;

procedure sfarsit;
 begin
  while final<>nil do
   begin
    pz:=pz+1;
    mut[pz,1]:=final^.a;
    mut[pz,2]:=final^.b;
    mut[pz,3]:=final^.c;
    final:=final^.tata;
   end;
 end;

function testare(var a,b,c:integer; a1,b1,c1:integer;mut1,mut2:integer):boolean;
 var test:boolean;
 begin
  test:=true;
  if a<>a1 then test:=false;
  if b1<>b+b then test:=false;
  if c1<>c-b then test:=false;
  if test then begin
                a:=a1;
                b:=b1;
                c:=c1;
                writeln(f,mut1,' ',mut2);
               end;
  testare:=test;
 end;

function cantare(var a,b,c:integer;a1,b1,c1,mut1,mut2:integer):boolean;
 var test:boolean;
 begin
  test:=false;
  if testare(a,b,c,a1,b1,c1,mut1,mut2) then test:=true
  else if testare(a,b,c,b1,a1,c1,mut1,mut2) then test:=true
  else if testare(a,b,c,c1,a1,b1,mut1,mut2) then test:=true
  else if testare(a,b,c,a1,c1,b1,mut1,mut2) then test:=true
  else if testare(a,b,c,b1,c1,a1,mut1,mut2) then test:=true
  else if testare(a,b,c,c1,b1,a1,mut1,mut2) then test:=true;
  cantare:=test;
 end;

procedure tiparire;
 var i:integer;
 begin
  assign(f,'saci.in');
  reset(f);
  readln(f,a,b,c);
  close(f);
  assign(f,'saci.out');
  rewrite(f);
  writeln(f,pz-1);
  for i:=pz-1 downto 1 do
   begin
    if cantare(a,b,c,mut[i,1],mut[i,2],mut[i,3],3,2) then
    else if cantare(a,c,b,mut[i,1],mut[i,2],mut[i,3],2,3) then
    else if cantare(b,a,c,mut[i,1],mut[i,2],mut[i,3],3,1) then
    else if cantare(b,c,a,mut[i,1],mut[i,2],mut[i,3],1,3) then
    else if cantare(c,a,b,mut[i,1],mut[i,2],mut[i,3],2,1) then
    else if cantare(c,b,a,mut[i,1],mut[i,2],mut[i,3],1,2) then ;
   end;
  close(f);
 end;

procedure stergere;
 begin
  temp:=rad;
  while temp<>nil do
   begin
    final:=temp;
    temp:=temp^.dr;
    dispose(final);
   end;
 end;

begin
 citire;
 initializare;
 cautare;
 sfarsit;
 tiparire;
 stergere;
end.

[BACK]


 

 

Fisierele de teste :

Test 1 :
3000 3000 3000

Test 3 :
17 12 4

Test 4 :
12 87 16

Test 5 :
97 89 99

Test 6 :
24 84 1

Test 7 :
2324 223 1431

Test 8 :
17 2321 2312

Test 9 :
1 64 96

Test 10 :
17 23 5

[BACK]