Pascal

   Programe back-traking:
Program interclasare in si din fisiere
Program cu combinatii de litere (argv)
Program monede
Program combinatii de '+' si '-'

program inter_fis;
var x,y:array [1..100]of string;
fx,fy,fxy:text;
s:string;
i,j,m,n:byte;


begin
assign(fx,'x.txt'); assign(fy,'y.txt'); assign(fxy,'xy.txt');
reset(fx); reset(fy); rewrite(fxy);

i:=0;
while not eof(fx) do
begin
i:=i+1;
readln(fx,x[i]);
end;
j:=0;
while not eof(fy) do
begin
j:=j+1;
readln(fy,y[j]);
end;
n:=i ; m:=j;
i:=1 ; j:=1;
while (i<=n) and (j<=n) do
begin
if x[i] writeln(fxy,x[i]);
inc(i);
end
else
begin
writeln(fxy,y[j]) ;
inc(j);
end;
end;


while (i<=n) do begin
writeln(fxy,x[i]);
inc(i);
end;
while (j<=m) do begin
writeln (fxy,y[j]);
inc(j);
end;
close(fx);
close(fy);
close (fxy);
end.

---

program argv;
const d:array[1..4] of char=('A','R','G','V');
var x:array[1..100]of integer;
n,k:integer;

function valid(k:byte):boolean;
var i,s:integer;
begin
s:=0;
valid:=(x[k]<>x[k-1]) and (k<=n);
end;

function solutie(k:byte):boolean;
var i,s:integer;
begin
s:=0;
for i:=1 =o k do if x[i]=2 then s:=s+1;
solutie:= (k=n)and (s=n div 2);
end;


procedure afisare(k:integer);
var i:byte;
begin
for i:=1 to k do write(d[x[i]]);
writeln ;
end;


Begin
write('n='); readln(n);
k:=1; x[k]:=0;
repeat
x[k]:=x[k]+1;
if x[k]>4 then k:=k-1
else
if valid(k) then
if solutie(k) then afisare(k)
else
if k begin
k:=k+1;
x[k]:=0;
end;


until k=0;
readln;
end.

---

program monede;
var m,a,x:array[1..100]of integer;
i,n,k,s:integer;

function valid(k:byte):boolean;
var sm,i:integer;
begin
sm:=0;
for i:=1 to k do sm:=sm+a[i]*x[i];
valid:=(sm<=s)and (k<=n);
end;

function solutie(k:byte):boolean;
var sm,i:integer;
begin
sm:=0;
for i:=1 to k do sm:=sm+a[i]*x[i];
solutie:=(sm=s)and (k=n);
end;


procedure afisare(k:integer);
var i:byte;
begin
for i:=1 to k do write(a[i],'*',x[i], ' ');
writeln
end;


Begin
write('s='); readln(s);
write('n='); readln(n);
for i:=1 to n do

begin
readln(a[i]);
m[i]:=s div a[i];
end;

k:=1; x[k]:=-1;
repeat
x[k]:=x[k]+1;
if x[k]>m[k] then k:=k-1
else
if valid(k) then
if solutie(k) then afisare(k)
else
begin
if k=n then
else
begin
k:=k+1;
x[k]:=-1;
end;
end;

until k=0;
readln;
end.

---

program back;
const d:array[1..2] of char=('+','-');
var a,x:array[1..100]of integer;
i,k,n:integer;

function valid(k:integer):boolean;
var s,i:integer;
begin
s:=a[1];
for i :=1 to k do if x[i]=1 then s:=s+a[i+1]
else s:=s-a[i+1];
valid:=(s>0);

end;


function solutie(k:integer):boolean;
begin
solutie:=(k=n-1);
end;

procedure afisare(k:integer);
var i:integer;
begin
for i:=1 to n-1 do write(a[i],d[x[i]]);
write (a[n]);
writeln;
end;


Begin
write ('n= '); readln(n);
for i:=1 to n do readln(a[i]);
k:=1; x[k]:=0;
repeat
x[k]:=x[k]+1;
if x[k]>2 then k:=k-1
else
if valid(k) then
if solutie(k) then afisare(k)
else
begin
k:=k+1;
x[k]:=0;
end;
until k=0;
end.