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.
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.
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