Problema Problema COLORCOLORĂRI ĂRI HĂRŢILORHĂRŢILOR

Pop Eugen cls. A XI-a B

Enunţul problemeiEnunţul problemei

• Fiind dată o hartă cu n ţări, se cer toate soluţiile de colorare a harţii, utilizând cel mult 4 culori, astfel încat două ţări cu frontieră comună să fie colorate diferit.

• Este demonstrat faptul că sunt suficiente numai 4 culori pentru ca orice hartă sa poată fi colorată.

Exemplu:Exemplu:

1

2

3

4

5

Ţara 1 – culoarea

Ţara 2 – culoarea

Ţara 3 – culoarea

Ţara 4 - culoarea

Ţara 5 – culoarea

ROŞU

VERDE

ROŞU

ALBASTRU

GALBEN

ROŞU

VERDE

ROŞU

ALBASTRU

GALBEN

Implementare:Implementare:Harta este furnizată programului cu ajutorul unei Harta este furnizată programului cu ajutorul unei

matrice An,n.matrice An,n.

Matricea Matricea AA este simetrică. Pentru rezolvarea este simetrică. Pentru rezolvarea problemei se utilizează stiva problemei se utilizează stiva stst, unde nivelul , unde nivelul kk al al

stivei simbolizează ţara stivei simbolizează ţara kk, iar , iar st[k]st[k] culoarea culoarea ataşată ţării k. Stiva are înălţimea ataşată ţării k. Stiva are înălţimea nn şi pe fiecare şi pe fiecare

nivel ia valori între nivel ia valori între 11 şi şi 44..

altfel 0

jcu ăînvecineaz se i dacă 1j)A(i,

Program:Program:program colorareprogram colorare__harta;harta;type stiva=array[1..100] of integer;type stiva=array[1..100] of integer;var st: stiva;var st: stiva; i,j,n,k:integer;i,j,n,k:integer; as, ev:boolean;as, ev:boolean; a:array[1..20, 1..20] of integer;a:array[1..20, 1..20] of integer;procedure init(k:integer; var st:stiva);procedure init(k:integer; var st:stiva);beginbegin

st[k]:=0;st[k]:=0;end;end;procedure succesor(var as: boolean; var st:stiva; k:integer);procedure succesor(var as: boolean; var st:stiva; k:integer);beginbegin

if st[k]<4 then beginif st[k]<4 then begin st[k]:=st[k]+1;st[k]:=st[k]+1; as:=trueas:=true endend else as:=falseelse as:=falseend;end;

procedure valid(var ev:boolean; st:stiva; k:integer);procedure valid(var ev:boolean; st:stiva; k:integer);var i:integer;var i:integer;beginbegin

ev:=true;ev:=true;for i:=1 to k-1 do for i:=1 to k-1 do

if (st[i]=st[k]) and (a[i,k]=1) then ev:=falseif (st[i]=st[k]) and (a[i,k]=1) then ev:=falseend;end;function solutie(k:integer):boolean;function solutie(k:integer):boolean;beginbegin

solutie:=(k=n)solutie:=(k=n)end;end;procedure tipar;procedure tipar;var i:integer;var i:integer;beginbegin

for i:=1 to n do writeln('Tara= ', i, '; culoarea= ', st[i]);for i:=1 to n do writeln('Tara= ', i, '; culoarea= ', st[i]);writeln('-------------');writeln('-------------');

end;end;

BEGINBEGINwrite('Numarul de tari= '); readln(n);write('Numarul de tari= '); readln(n);for i:=1 to n dofor i:=1 to n do

for j:=1 to i-1 do beginfor j:=1 to i-1 do begin write('a[',i,',',j,']='); readln(a[i,j]);write('a[',i,',',j,']='); readln(a[i,j]); a[j,i]:=a[i,j]a[j,i]:=a[i,j] end; end;

k:=1; init(k, st);k:=1; init(k, st);while k>0 do beginwhile k>0 do begin

repeatrepeat succesor(as, st, k);succesor(as, st, k); if as then valid(ev, st, k);if as then valid(ev, st, k); until (not as) or (as and ev);until (not as) or (as and ev); if as thenif as then if solutie(k) then tiparif solutie(k) then tipar else begin else begin k:=k+1;k:=k+1; init(k, st);init(k, st); end end else k:=k-1;else k:=k-1; end;end;

readln;readln;END.END.