Backtracking
1.Sa se
plaseze pe o tabla de sah 8 dame astfel incat sa
nu se atace reciproc.Sa se genereze toate solutiile.
Comentariu:
Pe fiecare linie trebuie
sa stea o singura dama.Procedura pune_dama are ca parametru linia pe care trebuie
sa se aseze o dama astfel incat
san u fie atacata de damele
pozitionate anterior.Pentru
fiecare pozitie corecta gasita,procedura
se autoapeleaza pentru linia urmatoare.
program
dame;
const nmax=20;
var n,i,j:byte;
a:array[1..nmax]
of 0..nmax;
nrs:byte;
procedure afis;
var i,j:byte;
begin
for i:=1 to n do begin
for
j:=1 to n do
if a[i]=j then write(* );
else
write(0 );
writeln
end;
nrs:=nrs+1;
end;
procedure pune_dama(x:byte);
var I,j,:byte;v:boolean;
begin
if
x>n then afis else for i:=1
to n do
begin
v:=true;
for
j:=1 to x-1 do
if a[j]=I
or abs(j-x)=abs(a[j]-i) then
v:=false;
if v
then begin
a[x]:=I;
pune_dama(x+1);
end;
end;
end;
begin
write(introduceti dimensiunea tablei de sah:);readln(n);
nrs:=0;
pune_dama(1);
writeln(numarul de solutii :,nrs);
end.
2.Se dau n tipuri de monezi.Sa se plateasca o suma data s,folosind un numar minim de monezi din tipurile date.Se considera ca exista un numar sufficient de monezi dn fiecare tip.
Comentariu:
Procedura rec primeste ca parametru un tip de moneda si incearca sa-l
foloseasca pentru plata sumei ramase
pana la momentul current,pornind de la numarul maxim de monezi pe care il poate
folosi si pana la 0,procedura apelandu-se
recursive pentru moneda urmatoare.
program factura;
const nmax=100;
var i,n,s:byte;
a,b,bm:array[1..nmax]
of byte;
nr,nrm:byte;
procedure rec(x:byte);
var i:integer;
begin
if
nr<=nrm or nrm=0 then
begin
if
x>n then
begin
if
s=0 and nr<=nrm or nrm=o
then
begin
bm:=b;
nrm:=nr;
end;
end
else for i:=s div a[x] downto
0 do begin
s:=s-a[x]*i;
b[x]:=i; nr:=nr+i;
rec(x+1);
s:=s+a[x]*i;
nr:=nr-i;
end
end;
end;
begin
write(intoduceti numarul de tipuri de monezi:);readln(n);
writeln(introduceti valorile monezilor:);
for i:=1 to n do read( a[i]);
write(introduceti suma de platit:);readln(s);
nr:=0;
nrm:=0;rec(1);
if nrm=0 then begin
if s=0
then writeln(factura nu trebuie platita)
else
writeln(nu se poate plati suma
data);
end
else begin
writeln(numarul minim de monezi este:,nrm);
for
i:=1 to n do if bm[i]<>0 then
writeln (bm[i],monezi
de ,a[i], lei);
end
end.
3.Se
considera o stiva de case
de bani sub forma de piramida
.Astfel pe primul nivel vor
fi n case ,pe urmatorul n-1 ,apoi n-2 ,
pana la ultimul nivel unde va
fi o singura casa de bani.Deci fiecare casa se va sprijini pe
doua case din etajul
anterior ,in total fiind n(n+1)/2 case de bani.
Se dau n(n+1)/2 saci cu bani,fiecare continand o anumita suma .Sa se distribuie acseti saci ,fiecare intr-o
casa,astfel incat in fiecare casa sa fie tot atatia bani cat pe celelalte doua
case pe care se sprijina la
un loc.Pentru casele din stratul de baza nu exista nici
o restrictie.
Datele vor fi citite
dintr-un fisier alcarui nume este
intreodus de la tastatura,cu
urmatorul format:
n
s1,s2,s3
sn(n+1)/2
unde n este numarul
de cutii din stratul de baza ,iar s1,s2
sunt sumele de bani din fiecare sac.Rezultatul va fi afisat p[e ecran
sub forma unei piramide in
care sunt trecute sumele de banio din fiecare casa.
Program
saculeti;
const nmax=100;
var s:string;f:text;ver:Boolean;
I,j,t,n,m:integer;
b:array[1..nmax*(nmax+1)
div 2] of integer;
a:array[1..nmax,1..nmax]
of integer;
procedure afis;
var I,j:integer;
begin
for i:=1 to n do begin
for
j:=1 to n-i div 2 do write( );
if
odd(n-i) then write( );
for
j:=1 to i do write (a[i,j]:6);
writeln;
end;
end;
procedure pune(s:integer);
var i,j:byte;
begin
if
s>m then begin afis;end else begin
for i:=1 to n do for j:=1 to i do
if a[i,j]=0 then begin
ver:=true;
if i>1 then begin
if
j<i then if
(a[i,j+1]=o and a[i-1,j]<=b[s] or a[i,j+{1]<>0)
and (a[i-1,j]<>b[s]+a[i,j+1])
the ver:=false;
if
j>1 then
if
(a[i,j-1]=0 and a[i-1,j-1]<=b[s] or a[i,j-1]<>0) and
(a[i-1,j-1]<>b[s]+a[i,j-1]) then ver:=false;
end;
if ver then begin
a[i,j]:=b[s];
pune(s+1);a[i,j]:=0;
end end end end;
begin
write(introduceti numele fisierului:);readln(s);
assign(f,s);reset(f);
read(f,n);m:=n*(n+1)
div 2 ;
for i:=1 to *(n+1) div 2 do read (f,b[i]);
close(f);
for i:=1 to m-1 do
for
j:=i+1 to m do
if b[i]<b[j] then begin
t:=b[i];b[i]:=b[j];b[j]:=t;
end;
pune(1);
writeln(nu exista solutie);
end.
4.Se da o lista formata
din n cuvinte .Sa se formeze
cu ele cel mai lung sir in care fiecare cuvant incepe cu litera cu care se termina predecesorul sau (mai putin primul
cuvant care poate fi oarecare ).Datele
se citesc dintr-un fisier al carui nume se inroduce de la tastatura,cu urmatorul format:
n
c1
c2
c3
.
.
.
cn
unde n-=numarul de cuvinte si c1.. cn cuvintele.
Comentariu:
Vom memora intr-un tablou separat ultima litera a fiecarui cuvant ,iar in alt tablou cuvintele care incep cu o litera pereche(perechea c,d-in c[i] numarul de cuvinte
care incep cu litera de cod
i,iar in d[i]-lista acestor cuvinte).
program cuvinte;
const nmax=30;
var
a:array[1..nmax]
of string;
b:array[1..nmax]
of byte;
c:array[0..255]
of byte;
d:array[0..255,1..nmax]
of byte;
e:array[1..nmax]
of boolean;
sol,solm:array[0..nmax]
of byte;
nrm;byte;
f:text;s:string;
i,j,n:byte;
procedure rec (x:integer);
var i:integer;sfarsit:boolean;ulti:byte;
begin
if
x=1 then
for i:=1 to n do begin
e[i]:=true;sol[x]:=i;
rec(x+!);
e[i]:=false;
end
else
begin
sfarsit:=true;ultimalitera:=b[sol[x-1]];
for i:=1 to c[ulti] do
if not e[d[ulti,i]] then begin
sfarsit:=false; e[d[ulti,i]]:=true;
sol[x]:=d[ulti,i];
rec(x+1);
e[d[ulti,i]]:=false
ens;
if sfarsit then if x-1>nrm then begin
solm:=sol;nrm:=x-1
end
end
end;
begin
write(intorduceti nume;le fisierului:);readln(s);
assign(f,s);reset(f);
readln(f,n);
for i:=1 to n do readln (f,a[i]);
for i:=0 yo 255 do c[i]:=0;
for i:=1 to n do begin
b[i];=ord (a[i][length(a[i])]);
inc(c[ord(a[i,1])]);
d[ord(a[i,1]),c[ord(a[i,1])])]]:=i;
e[i]:=false;
end;
nrm:=0;
rec(1);
writeln(soluita cea mai
buna este:);
for i:=1 to nrm do write(a[solm[i]], );
writeln
end.
5.
Fie A=[a1..an]
cu elemente de tipul integer.Sa se determine toate modalitatile de a aranja elementele in grupe de p elemente distincte,p<n.
program arajamente;
type
sir=array[1..100] of integer;
var x:sir;
p,i,k,n:integer;
as,ev:boolean;
a:array[1..100]
of integer;
procedure succ(var x:sir;k:integer;var
as:boolean);
begin
if
x[k]>n then begin
as:=true;x[k]:=x[k+1];
end
else
as:=false;
end;
procedure
valid (x:sir;k:integer;var ev:boolean);
begin
ev :=true;
if
k>=2 and not a[x[k]]>a[x[k-1]] then ev:=false;
end;
procedure afis(x:sir;k:integer);
var i:integer;
begin
for i:=1 to k write(a[x[i]]:5);
writeln
end;
begin
write(n=);readln(n);
for i:=1 to n do readln(a[i]);
write(p=);read(p);
k:=1;
x[k]:=0;
while
k>0 do begin
repeat
succ(x,k,as);
if as
then valid(x,k,ev)
until asand ev or not as if as then if
k=p then afis
else begin k:=k+1;
x[k]:=0
end
else
k:=k-1
end;
readln;
end.
6.Problema colorarii hartii.Fiind data o harta cu n tari ,se cer toate
modaliattile de colorare a hartii,utilizand cel mult m culori,astfel incat doua tari
cu frontiera comuna sa fie colorate diferit.Este demonstrat faptul ca sunt suficiente numai patru culori pentru
ca orice gharta sa fie colorata.
Comentariu:
k:variabila intreaga,care reprezinta o
x:vector cu componente intregi cu proprietatea:xk:reprezinta
culoarea tarii cu numarul k.
program harta;
type
sir=array[1..100] of integer;
var x:sir;
m,i,k,n:integer;
as,ev:boolean;
a:array[1..20,1..20] of integer;
procedure succ (var x:sir;k:integer;var
as:boolean);
begin
if
x[k],m then begin
as:=true;
x[k]:=x[k+1];
end
else
as:=false;
end;
procedure
valid (x:sir;k:integer;var ev:boolean);
begin
ev:=true;
for i:=1 to k-1 do if a[k,i]=1 and
x[k]=x[i] then ev:=false;
end;
procedure afis (x:sir;k:integer);
var i:integer;
begin
for i:=1 to k do write(x[i[:5);
writeln end;
begin
write(n=);readln(n);
for i:=1to n-1 do for j:=i+1 to n do
begin
readln(a[i,j]);
a[j,i]:=a[i,j];
end;
write(m=);readln(m);
k:=1;
x[k]:=0;
while
k>0 do begin
repeat
succ(x,k,as);
if as
then valid(x,k,ev) until (as and ev)
or( not as);
if as
then if k=n then afis(x,k)
else begin
k:=k+1;
x[k]:=0;
end
else
k:=k-1;
end;
readln;
end.