|
|
|
Metoda backtracking
Este o tehnica de programare aplicabila algoritmilor care ofera mai multe solutii si are ca rezultat obtinerea tuturor solutiilor problemei. Fiecare solutie se memoreaza intr-o structura de date de tip stiva implementata cu ajutorul unui vector. Deci fiecare solutie poate fi pusa sub forma unui vector.
Intr-un algoritm backtracking ne intereseaza toate solutiile posibile. Pentru a obtine fiecare solutie finala se completeaza stiva nivel cu nivel trecand astfel prin niste solutii partiale. Astfel solutiile finale cat si cele partiale pentru a fi luate in considerare trebuie sa indeplineasca anumite conditii numite conditii de validare. O solutie care indeplineste o astfel de conditie se numeste solutie valida.
Toate configuratiile stivei ce reprezinta solutii finale sunt alcatuite din elementele aceleiasi multimi bine definite pe care o numim multimea solutiilor. Fiecare noua solutie partiala se obtine prin completarea solutiei partiale precedente cu inca o nivel pe stiva. La fiecare nivel se pun valori din multimea solutiilor care nu au fost incercate pana cand se obtine o solutie valida. In acest moment se trece la nivelul urmator in stiva pentru a completa mai departe solutia reluand incercarile pe noul nivel.
La un moment dat pe un anumit nivel nu mai exista nici o valoare neincercata din multimea valorilor problemei. In acest caz se face un pas inapoi in stiva la nivelul anterior si se reia cautarea cu valorile ramase neincercate pe acest nivel anterior.
Respectivul nivel a mai fost vizitat dar l-am abandonat dupa ce am pus o valoare care a generat o solutie valida. Deci este posibil sa fi ramas aici valori neincercate. Daca nici pe acest nivel nu mai avem valori neincercate mai facem un pas inapoi in stiva. Mecanismul revenirilor a determinat denumirea de metoda backtracking.
Plecand de la nivelul 1 si repetand algoritmul pana cand pe toate nivelele au fost incercate toate valorile din multimea valorilor se obtin solutii finale care se tiparesc.
Vom implementa metoda backtracking iterativ folosind o rutina unica aplicabila oricarei probleme. Rutina va apela proceduri si functii care au intotdeauna acelasi nume si parametri si care din punct de vedere al metodei realizeaza acelasi lucru.
Sarcina rezolvatorului este sa scrie explicit - pentru fiecare problema - procedurile si functiile aplicate pe rutina. Astfel gasirea urmatorului element netestat de pe un nivel k al stivei St se face cu procedura succesor (as,St,k)
Odata ales un element testarea conditiilor de validare se face cu procedura valid (ev,St,k).
Testul daca s-a ajuns sau nu la o solutie finala se face cu functia solutie (k)
Solutia se tipareste cu procedura tipar.
De asemenea fiecare nivel al stivei trebuie initializat cu o valoare aflata inaintea tuturor valorilor posibile din multimea solutiilor. Aceasta afisare se face cu procedura init (k,St).
K:=1; init (1,St);
while k>0 do
begin
repeat
succesor (as,St,k);
if as then valid (ev,St,k);
until (not as) or (as and ev);
if as then
if solutie (k) then tipar
else begin
k:=k+1;
init(k,St);
end;
else k:=k-1;
end;
end;
1. Generarea permutarilor.
program permutari;
type stiva=array [1..10] of integer;
var st:stiva;
ev,as:boolean;
n,k:integer;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin if st[k]<n then begin st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if st[i]=st[k] then ev:=false;
if (st[k]<0) and (st[k-1]<0) then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do write (st[i]);
writeln;
end;
begin;
write ('n:=');readln (n);
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor (as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then
if solutie(k) then tipar
else begin
k:=k+1;
init(k,st)
end
else k:=k-1;
end;
readln;
end.
2. Generarea aranjamentelor.
program aranjamente;
type stiva=array [1..10] of integer;
var st:stiva;
ev,as:boolean;
n,k,p:integer;
procedure init(k:integer;var st:stiva);
begin st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin if st[k]<n then begin st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if st[i]=st[k] then ev:=false;
if (st[k]<0) and (st[k-1]<0) then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=p);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to p do write (st[i]);
writeln;
end;
begin;
write ('n:=');readln (n);
write ('p:=');readln (p);
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor (as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then
if solutie(k) then tipar
else begin
k:=k+1;
init(k,st)
end
else k:=k-1;
end;
readln;
end.
3. Generarea combinarilor
program combinari;
type stiva=array [1..10] of integer;
var st:stiva;
ev,as:boolean;
n,k,p:integer;
procedure init(k:integer;var st:stiva);
begin
if k>1 then st[k]:=st[k-1]
else if k=1 then st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n-p+k then begin st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if st[i]=st[k] then ev:=false;
if (k=>2) and (st[k-1]>st[k]) then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=p);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to p do write (st[i]);
writeln;
end;
begin;
write ('n:=');readln (n);
write ('p:=');readln (p);
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor (as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then
if solutie(k) then tipar
else begin
k:=k+1;
init(k,st)
end
else k:=k-1;
end;
readln;
end.
4. Dintr-un nr. de 6 cursuri optionale un elev trebuie sa aleaga 3. Sa se afiseze toate posibilitatile de alegere precum si nr. lor.
program cursuri;
const n=6;
p=3;
type stiva=array [1..10] of integer;
var st:stiva;
ev,as:boolean;
k:integer;
procedure init(k:integer;var st:stiva);
begin
if k>1 then st[k]:=st[k-1]
else if k=1 then st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n-p+k then begin st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if st[i]=st[k] then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=p);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to p do write (st[i]);
writeln;
end;
begin;
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor (as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then
if solutie(k) then tipar
else begin
k:=k+1;
init(k,st)
end
else k:=k-1;
end;
readln;
end.
5. Numerele care ii plac lui Gigel
Lui Gigel ii plac nr. formate numai din cifre pare cifre aflate in ordine descrescatoare. Sa se determine si sa se afiseze pe ecran toate nr. de n cifre (0<n<10) care ii plac lui Gigel. Valoarea lui n este un nr. natural care se citeste de la tastatura.
program nr_lui_gigel;
type stiva=array[1..100] of integer;
var st:stiva;
i,n,k:integer;
as,ev:boolean;
procedure init(k:integer;var st:stiva);
begin
st[k]:=-1;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<9 then begin st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do
if st[i] mod 2 <> 0 then ev:=false;
for i:=1 to k-1 do
if st[i]<st[i+1] then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do write(st[i]);
writeln;
end;
begin
write('n= ');readln(n);
k:=1 ;init(k,st);
while k>0 do
begin
repeat
succesor(as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then if solutie(k) then tipar
else begin
k:=k+1;
init(k,st);
end
else k:=k-1;
end;
readln;
end.
6. La un concurs sportiv s-au inscris n concurenti avand numerele de concurs 1,2,,n. Pentru fiecare sportiv se cunoaste tara de origine (sir de caractere). In prima zi vor intra in concurs m concurenti. Afisati toate posibilitatile de a stabili ordinea intrarii in concurs a celor m concurenti respectand urmatoarele conditii:
2 sportivi din aceeasi tara nu pot evolua unul dupa altul
trebuie respectata ordinea crescatoare a numerelor de concurs ale sportivilor.
program comcurs_sportiv;
type stiva=array[1..100] of integer;
var st:stiva;
tara:array[1..50] of string;
m,i,n,k:integer;
as,ev:boolean;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n then begin st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if st[k]=st[i] then ev:=false;
if (k>1) and (tara[st[k-1]]=tara[st[k]]) then ev:=false;
if (k>1) and (st[k]<st[k-1]) then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=m);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to m do write(st[i],' ');
writeln;
end;
begin
write('n= '); read(n);
write('m= '); read(m);
for i :=1 to n do
begin
write('concurentul',i,'=');readln(tara[i]);
end;
while k>0 do
begin
repeat
succesor (as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then
if solutie(k) then tipar
else begin
k:=k+1;
init(k,st)
end
else k:=k-1;
end;
readln;
end.
7. Sa se afiseze toate modurile posibile de a descompune un numar natural n in suma de k numere naturale diferite(n si k sunt cunoscute).
program desc;
type stiva=array[1..100] of integer;
var st:stiva;
s,n,k,p:integer;
as,ev:boolean;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n-p+k then begin
st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
s:=0;
ev:=true;
for i:=1 to k-1 do if st[k]=st[i] then ev:=false;
if (k>=2) and (st[k]<st[k-1]) then ev:=false;
for i:=1 to k do s:=s+st[i];
if s>n then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=p);
end;
procedure tipar;
var i:integer;
begin
if s=n then
for i:=1 to p do write(st[i],' ');
writeln;
end;
begin
write ('n:=');readln (n);
write ('p:=');readln (p);
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor (as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then
if solutie(k) then tipar
else begin
k:=k+1;
init(k,st)
end
else k:=k-1;
end;
readln;
end.
8. La un festival de muzica s-au inscris n melodii codificate 1,2,3,,n (n>=4). Sa se afiseze toate posibilitatile de a stabili ordinea intrarii in concurs a melodiilor stiind ca melodiile cu codurile C1 si C2 trebuie obligatoriu sa evolueze a doua respectiv penultima. Valorile lui C1 si C2 se citesc de la tastatura C1,C2 apartin .
program festival;
type stiva=array[1..100] of integer;
var st:stiva;
k,n,C1,C2:integer;
as,ev:boolean;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n then begin
st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if st[k]=st[i] then ev:=false;
if (k=2) and (st[k]<>C1) then ev:=false;
if (k=n-1) and (st[k]<>C2) then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do write(st[i]);
writeln;
end;
begin
write('n=');readln(n);
write('melodia a II-a este: ');readln(C1);
write('penultima melodie este: ');readln(C2);
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor (as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then
if solutie(k) then tipar
else begin
k:=k+1;
init(k,st)
end
else k:=k-1;
end;
readln;
end.
9. Se da un numar natural par. Sa se afiseze toate sirurile de n paranteze care se inchid corect.
program paranteze;
type stiva=array[1..100] of integer;
var st:stiva;
npd,npi,n,k:integer;
as,ev:boolean;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<2 then
begin
st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
npd:=0;
npi:=0;
for i:=1 to k do
if st[i]=1 then npd:=npd+1
else npi:=npi+1;
if (npd>=npi) and (npd<=n div 2) then ev:=true
else ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n);
end;
procedure tipar;
var i:integer;
begin
if npd=npi then
for I:=1 to k do
if st[i]=1 then write('(')
else write(')');
writeln;
begin
write('n= ');read(n);
st[1]=1;
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor (as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then
if solutie(k) then tipar
else begin
k:=k+1;
init(k,st)
end
else k:=k-1;
end;
readln;
end.
10. Problema celor n dame.
Fiind data o tabla de sah n x n se cer toate solutiile de aranjare a n dame astfel incat sa nu se afle 2 dame pe aceeasi linie, coloana sau diagonala.
program dame;
type stiva=array[1..100] of integer;
var st:stiva;
n,k:integer;
as,ev:boolean;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n then begin st[k]:=st[k]+1;
as:=true end
else as:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if (st[k]=st[i]) or (abs(st[k]-st[i])=abs(k-i)) then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do write(st[i]);
writeln;
end;
begin
write('n:');readln(n);
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor(as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then if solutie(k) then tipar
else begin
k:=k+1;
init(k,st); end
else k:=k-1;
end;
readln;
end.
11. Se citesc n numere naturale si n multimi A1,A2,,An. Sa se calculeze produsul cartezian al multimilor date.
program pcartez;
type stiva=array[1..100] of integer;
var st:stiva;
i,n,k:integer;
as,ev:boolean;
a:array [1..100] of integer;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<a[k] then begin
st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
ev:=true;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do write(st[i]);
writeln;
end;
begin
write('Numarul de multimi= ');readln(n);
for i:=1 to n do begin
write('a[',i,']=');readln(a[i]);
end;
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor(as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then if solutie(k) then tipar
else begin
k:=k+1;
init(k,st);
end
else k:=k-1;
end;
end.
12. Se citeste un numar natural n. Se cere sa se tipareasca toate modurile de descompunere a lui n ca suma de numere naturale.
program desc2;
type stiva=array[1..100] of integer;
var st:stiva;
s,n,k:integer;
as,ev:boolean;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n then begin
st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
s:=0;
ev:=true;
for i:=1 to k do s:=s+st[i];
if s<=n then ev:=true
else ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(s=n);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to k do write(st[i]);
writeln;
end;
begin
write('n=');readln(n);
while k>0 do
begin
repeat
succesor(as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then if solutie(k) then tipar
else begin
k:=k+1;
init(k,st);
end
else k:=k-1;
end;
end.
13. Problema Comis-voiajor
Un comis-voiajor trebuie sa viziteze un numar n de orase. Initial, acesta se afla intr-unul dintre ele, notat 1. Comis-voiajorul doreste sa nu treaca de doua ori prin acelasi oras, iar la intoarcere sa revina in orasul 1. Cunoscand legaturile existente intre orase, se cere sa se tipareasca toate drumurile posibile pe care le poate efectua comis-voiajorul.
program comisv;
type stiva=array[1..100] of integer;
var st:stiva;
i,j,n,k:integer;
as,ev:boolean;
a:array[1..20,1..20] of integer;
procedure init(k:integer;var st:stiva);
begin
st[k]:=1;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n then begin
st[k]:=st[k]+1;
as:=true
end
else as:=false
end;
procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
ev:=true;
if a[st[k-1],st[k]]=0 then ev:=false
else
for i:=1 to k-1 do if st[i]=st[k] then ev:=false;
if (k=n) and (a[1,st[k]]=0) then ev:=false
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n)
end
procedure tipar;
var i:integer;
begin
for i:=1 to n do
write('nodul=',st[i]);
writeln('------');
end;
begin
write('nr. de noduri=');readln(n);
for i:= 1 to n do
for j:=1 to i-1 do begin
write('a[',i,',',j,']='); readln(a[i,j]);
a[j,i]:=a[j,i];
end;
end;
st[1]:=1; k:=2;
init(k,st);
while k>0 do
begin
repeat
succesor(as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then if solutie(k) then tipar
else begin
k:=k+1;
init(k,st);
end
else k:=k-1;
end;
end.
14. Scrieti un program care, folosind metoda backtracking, afiseaza toate modurile de a aranja elementele unui sir dat de numere intregi astfel incat in sirul rezultat sa nu existe doua elemente negative alaturate.
program sir;
type stiva=array[1..100] of integer;
vector=array[1..100] of integer;
var st:stiva;
n,k,i:integer;
as,ev:boolean;
a:vector;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n then begin
st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if st[k]=st[i] then ev:=false;
if (a[st[k]]<0) and (a[st[k-1]]<0) then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do write(a[st[i]],' ');
writeln;
end;
begin
write('n=');readln(n);
for i:=1 to n do
begin
write('a[',i,']=');readln(a[i]);
end;
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor(as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then if solutie(k) then tipar
else begin
k:=k+1;
init(k,st);
end
else k:=k-1;
end;
end.
15. Turnuri de cuburi
Se dau n cuburi numerotate 1,2,,n, de laturi Li si culori Ci, i=1,2,,n (fiecare culoare este codificata printr-un caracter). Sa se afiseze toate turnurile care se pot forma luand k cuburi din cele n disponibile, astfel incat:
-laturile cuburilor din turn sa fie in ordine crescatoare;
-culorile a oricare doua cuburi alaturate din turn sa fie diferite.
program cuburi;
type stiva=array [1..100] of integer;
var st:stiva;
i,n,p,k:integer;
as,ev:boolean;
L:array [1..10] of integer;
C:array [1..10] of char;
procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n then
begin
st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if L[st[k]]<=L[st[i]] then ev:=false;
if C[st[k]]=C[st[k-1]] then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=p);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to p do write(st[i],' ');
writeln;
end;
begin
write('n= ');read(n);
write('p= ');read(p);
for i:=1 to n do
begin
write('L[',i,']=');readln(L[i]);
write('C[',i,']=');readln(C[i]);
end;
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor(as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then if solutie(k) then tipar
else begin
k:=k+1;
init(k,st);
end
else k:=k-1;
end;
end.
16. Generarea partitiilor unui nr.
Se citeste un nr. natural n .Se cere sa sa tipareasca toate modurile de descompunere a lui n ca suma de nr. naturale.
program partitii_ale_unui_nr;
type stiva=array [1..10] of integer;
var st:stiva;
ev,as:boolean;
n,k:integer;
procedure init(k:integer;var st:stiva);
begin st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin if st[k]<n then begin st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i,s:integer;
begin s:=0;
for i:=1 to k do
s:=s+st[i];
if s<=n then ev:=true
else ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do write (st[i]);
writeln;
end;
begin;
write ('n:=');readln (n);
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor (as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then
if solutie(k) then tipar
else begin
k:=k+1;
init(k,st)
end
else k:=k-1;
end;
readln;
end.
17. Drapele
Se dau 7 culori, codificate prin nr. 1, 2, ., 7. Afisati toate posibilitatile de alcatuire a unor drapele tricolore care sa contina numai culori dintre cele date, astfel incat culoarea din mijloc sa apartina unui set dat de patru culori din randul celor 7 disponibile; a treia culoare nu poate sa fie c unde c este un nr. intreg cuprins intre 1 si 3; cele trei culori de pe drapel sa fie distincte.
program drapele;
const n=7;
type stiva=array [1..10] of integer;
var st:stiva;
ev,as:boolean;
n,k:integer;
procedure init(k:integer;var st:stiva);
begin st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin
if st[k]<7 then begin st[k]:=st[k]+1;
as:=true;
end
else as:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if st[i]=st[k] then ev:=false;
if (st[3]=1) or (st[3]=3) or (st[3]=2) then ev:=false;
if st[3]=(1,2,3) then ev:=false;
for i:=1 to 4 do if st[2]<>st[i] then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do write (st[i]);
writeln;
end;
begin;
k:=1;init(k,st);
while k>0 do
begin
repeat
succesor (as,st,k);
if as then valid(ev,st,k);
until (not as) or (as and ev);
if as then
if solutie(k) then tipar
else begin
k:=k+1;
init(k,st)
end
else k:=k-1;
end;
readln;
end.
Backtracking recursiv(dupa schema)
18. Generarea permutarilor.
program permutari;
type stiva=array [1..10] of integer;
var st:stiva;
ev:boolean;
n,k:integer;
procedure init(k:integer;var st:stiva);
begin st[k]:=0;
end;
function succesor(var st:stiva;k:integer);
begin
if st[k]<n then begin
st[k]:=st[k]+1;
succesor:=true;
end
else succesor:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do
if st[i]=st[k] then ev:=false;
if (st[k]<0) and (st[k-1]<0) then ev:=false;
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do write (st[i]);
writeln; end;
procedure back(k:integer)
begin
if k=n then tipar
else begin
init(k,st);
while succesor(st,k) do
begin
valid(ev,st,k);
if ev then back(k+1);
end;
end;
end;
begin
write('n= ');read(n);
back(1);readln;
end.
19. Generarea aranjamentelor.
program aranjamente;
type stiva=array [1..10] of integer;
var st:stiva;
ev:boolean;
n,k:integer;
procedure init(k:integer;var st:stiva);
begin st[k]:=0;
end;
function succesor(var st:stiva;k:integer);
begin
if st[k]<n then begin
st[k]:=st[k]+1;
succesor:=true;
end
else succesor:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do
if st[i]=st[k] then ev:=false;
if (st[k]<0) and (st[k-1]<0) then ev:=false
end;
procedure tipar;
var i:integer;
begin
for i:=1 to p do write (st[i]);
writeln;
end;
procedure back(k:integer)
begin
if k=p then tipar
else begin
init(k,st);
while succesor(st,k) do
begin
valid(ev,st,k);
if ev then back(k+1);
end;
end;
end;
begin
write('n= ');read(n);
write('p= ');read(p);
back(1);readln;
end.
20. Generarea combinarilor.
program combinarilor;
type stiva=array [1..10] of integer;
var st:stiva;
ev:boolean;
n,k:integer;
procedure init(k:integer;var st:stiva);
begin st[k]:=0;
end;
function succesor(var st:stiva;k:integer);
begin
if st[k]<n-p+k then begin
st[k]:=st[k]+1;
succesor:=true;
end
else succesor:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do
if st[i]=st[k] then ev:=false;
if (k=>2) and (st[k-1]>st[k]) then ev:=false;
end;
procedure tipar;
var i:integer;
begin
for i:=1 to p do write (st[i]);
writeln; end;
procedure back(k:integer)
begin
if k=p then tipar
else begin
init(k,st);
while succesor(st,k) do
begin
valid(ev,st,k);
if ev then back(k+1);
end;
end;
end;
begin
write('n= ');read(n);
write('p= ');read(p);
back(1);readln;
end.
Backtracking recursiv(fara schema)
21. Generarea permutarilor
program permutari;
type stiva=array [1..10] of integer;
var st:stiva;
n,k:integer;
procedure init(k:integer;var st:stiva);
begin st[k]:=0;
end;
function valid(k:integer):boolean;
var i:integer;
ok:boolean;
begin
ok=true;
for i:=1 to k-1 do
if st[i]=st[k] then ok=false;
valid:=ok
end;
procedure tipar;
var i:integer;
begin
for i:=1 to n do write (st[i]);
writeln;
end;
procedure back(k:integer)
var val:integer;
begin
for val :=1 to n do
begin
st[k]:=val;
if valid(k) then
if k=n then tipar
else back(k+1);
end;
begin
write('n= ');read(n);
init(k);
back(1);
end.
22. Generarea aranjamentelor.
program aranjamente;
type stiva=array [1..10] of integer;
var st:stiva;
n,k:integer;
procedure init(k:integer;);
begin st[k]:=0;
end;
function valid(k:integer):boolean;
var i:integer;
ok:boolean;
begin
ok=true;
for i:=1 to k-1 do
if st[i]=st[k] then ok:=false;
if (st[k]<0) and (st[k-1]<0) then ok:=false;
valid:=ok;
end;
procedure tipar;
var i:integer;
begin
for i:=1 to p do write (st[i]);
writeln;
end;
procedure back(k:integer)
var val:integer;
begin
for val :=1 to n do
begin
st[k]:=val;
if valid(k) then
if k=p then tipar
else back(k+1);
end;
begin
write('n= ');read(n);
write('p= ');read(p);
init(k);
back(1);
end.
23. Generarea combinarilor.
program combinarilor;
type stiva=array [1..10] of integer;
var st:stiva;
n,k:integer;
procedure init(k:integer);
begin st[k]:=0;
end;
function valid(k:integer):boolean;
var i:integer;
ok:boolean;
begin
ok:=true;
for i:=1 to k-1 do
if st[i]=st[k] then ok:=false;
if (k=>2) and (st[k-1]>st[k]) then ok:=false;
valid:=ok;
end;
procedure tipar;
var i:integer;
begin
for i:=1 to p do write (st[i]);
writeln;
end;
procedure back(k:integer)
var val:integer;
begin
for val :=1 to n-p+k do
begin
st[k]:=val;
if valid(k) then
if k=p then tipar
else back(k+1);
end;
begin
write('n= ');read(n);
write('p= ');read(p);
init(k);
back(1);
end.
