Referat Backtracking
Mai jos puteti citi fragmente din
Referat Backtracking si de asemenea puteti face
Download Referat BacktrackingCiteste fragmente din Referat Backtracking
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
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]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,pn 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 tara;
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.
ì¥Â@
