Question

PASCAL递归的简单题目，有重复元素的排列问题

输入样例
4
aacc
输出样例
aacc
acac
acca
caac
caca
ccaa
6
简单化了题目，但是应该看的明白，小弟指教了~

Answer 1

以下程序过了提供的样例，其中子程序中的hash是用来判重的，就是防止比如说aacc出现两次这样的问题，另外数组只开到100，你如果需要可以开更大，程序有看不懂的再发小纸条问好了
var a,b:array [0..100] of char;
used:array [0..100] of boolean;
i,n,total:longint;

procedure print;
var i:longint;
begin
for i:=1 to n-1 do write(a[i]);
writeln(a[n]);
inc(total);
end;

procedure search(k:longint);
var i:longint;
hash:array ['a'..'z'] of boolean;
begin
if k>n then print
else begin
fillchar(hash,sizeof(hash),false);
for i:=1 to n do
if (not(used[i])) and (not(hash[b[i]])) then begin
a[k]:=b[i];
hash[b[i]]:=true;
used[i]:=true;
search(k+1);
used[i]:=false;
end;
end;
end;

begin
readln(n);
for i:=1 to n do
begin
read(b[i]);
a[i]:=a[i];
end;
total:=0;
fillchar(used,sizeof(used),false);
search(1);
writeln(total);
end.

Answer 2

这个算法不知道对不对：
1.把元素(n个)从小到大排列
2.从n往前找，找到第一个i，满足a[i]<a[i+1]
3.从n往前找，找到第一个j，满足a[j]>a[i]
4.交换a[i],a[j]
5.将数组中i+1到n位置的数据从小到大排列，即可生成下一种排列
6.重复2至6步，知道找不到满足条件的i为止

PS：这是无重复元素的全排列算法，对有重复元素的好像也适用，不会生成重复的情况。

例：设当前排列为acca；
则i=1 (a[1]='a',a[2]='c','a'<'c')
j=3 (a[1]='a',a[3]='c','a'<'c')
交换a[i],a[j]后为ccaa
将a[i+1]至a[n]，即a[2]至a[4]从小到大排列，得caac
caac就是下一个排列

Answer 3

var
r:array[1..500]of char;
temp:char;
n,i,j,tot:integer;

procedure print;
var
i:integer;
begin
for i:=1 to n do write(r[i]);
inc(tot);
writeln;
end;

procedure work(l:integer);
var
i:integer;
a:array[32..127]of boolean;
begin
fillchar(a,sizeof(a),false);
if l=n then begin print;exit;end;
work(l+1);
a[ord(r[l])]:=true;
for i:=l+1 to n do
IF ((r[l]=r[i])and(i<>l))or a[ord(r[i])] then continue else
begin
temp:=r[l];
r[l]:=r[i];
r[i]:=temp;
a[ord(r[l])]:=true;
work(l+1);
temp:=r[i];
r[i]:=r[l];
r[l]:=temp;
end;
end;

begin
readln(n);
for i:=1 to n do read(r[i]);
work(1);
writeln('total:',tot);
end.

Answer 4

以下程序过了提供的样例，其中子程序中的hash是用来判重的，就是防止比如说aacc出现两次这样的问题，另外数组只开到100，你如果需要可以开更大，程序有看不懂的再发小纸条问好了
var
a,b:array
[0..100]
of
char;
used:array
[0..100]
of
boolean;
i,n,total:longint;
procedure
print;
var
i:longint;
begin
for
i:=1
to
n-1
do
write(a[i]);
writeln(a[n]);
inc(total);
end;
procedure
search(k:longint);
var
i:longint;
hash:array
['a'..'z']
of
boolean;
begin
if
k>n
then
print
else
begin
fillchar(hash,sizeof(hash),false);
for
i:=1
to
n
do
if
(not(used[i]))
and
(not(hash[b[i]]))
then
begin
a[k]:=b[i];
hash[b[i]]:=true;
used[i]:=true;
search(k+1);
used[i]:=false;
end;
end;
end;
begin
readln(n);
for
i:=1
to
n
do
begin
read(b[i]);
a[i]:=a[i];
end;
total:=0;
fillchar(used,sizeof(used),false);
search(1);
writeln(total);
end.