Moshu Junior

Data inscrierii: 08/Noi/2007 Mesaje: 6 Localitate: Ploiesti
|
Trimis: 15/11/2007 11:59 Titlul subiectului: pr 6 (varianta corecta) |
|
|
| Cod: | var n,j,m:integer;s1:string;
a:array [1..20] of char;v:array [1..20] of string;
s:array [1..10] of integer;
procedure init(k:integer);
begin
s[k]:=0;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=n+1);
end;
procedure afisare(k:integer);
var i:integer;
begin
inc(m);
for i:=1 to n do
v[m]:=v[m]+a[s[i]];
end;
function valid(k:integer):boolean;
var i,i1,nr,nr2:integer; s2:string;
begin
valid:=true;
if k=n then
begin
s1:='';i:=1;
for i:=1 to k do
s1:=s1+a[s[i]];
for i:=1 to n do
begin
nr:=0;nr2:=0; s2:=s1;
while pos(a[i],s2)<>0 do begin
inc(nr);
delete(s2,pos(a[i],s2),1);
end;
for i1:=1 to k do
if a[i1]=a[i] then inc(nr2);
if nr<>nr2 then valid:=false;
end;
for i:=1 to m do
if s1=v[i] then valid:=false;
end;
end;
function succesor(k:integer):boolean;
begin
if s[k]<n then begin
s[k]:=s[k]+1;
succesor:=true;
end
else succesor:=false;
end;
procedure back(k:integer);
begin
if solutie(k) then afisare(k)
else begin
init(k);
while succesor(k) do
if valid(k) then back(k+1);
end;
end;
begin
write('n=');readln(n);
for j:=1 to n do
begin
write('a[',j,']=');readln(a[j]);
end;
for j:=1 to n do
v[1]:=v[1]+a[j];
m:=1;
writeln;
back(1);
for j:=2 to m do
writeln(v[j]);
readln
end.
|
|
|