QBHV spoj – Hoán vị chữ cái

Nguồn đề bài: http://vn.spoj.com/problems/QBHV/

1. Đề bài QBHV spoj

Cho một xâu S chỉ gồm các chữ cái in hoa, 1 <= độ dài <= 9.

Yêu cầu:

1: Có bao nhiêu cách hoán vị các chữ cái của xâu S

2: Liệt kê các hoán vị đó theo thứ tự từ điển

Input

Gồm 1 dòng duy nhất chứa xâu S

Output

Dòng 1: Ghi số lượng hoán vị tìm được (K)

K dòng tiếp theo, mỗi dòng ghi một xâu hoán vị của xâu S theo đúng thứ tự từ điển

Example

Input:
ABAB
Output:
6
AABB
ABAB
ABBA
BAAB
BABA
BBAA

2. Hướng dẫn QBHV spoj

– đầu tiên bạn sắp xếp xâu theo thứ tự chữ cái ABC…

– tính trước số hoán vị không lặp. phần này bạn có thể tham khảo bên toán

– sử dụng quay lui, vừa quay vừa xuất :)) trong quá trình quay lui bạn có thể đặt nhánh cận. so sánh với kết quả đã write trước đó. bạn có thể tham khảo code. ở dòng:

 if ch>kq[spt] then  try(i+1);

code tham khảo chưa thật sự tối ưu phần lưu trữ cũng như tính k, vì vậy bạn có thể cải tiến tốt hơn

Đã bổ sung code chuẩn bằng PP sinh (26/3/2015)

3. code tham khảo QBHV spoj pascal

a. Code tham khảo 1

program bt;
const   fi='';
        fo='';
var
        s:string[10];
        f:text;

        DD:array[1..9] of boolean;
        kq:array[0..362880] of string[9];
        spt:LONGINT;
        ch:string[9];
        GT:array[0..9] of longint=(1,1,2,6,24,120,720,5040,40320,362880);

procedure docfile;
begin
        assign(f,fi); reset(f);
        readln(f,s);
        close(f);
end;

procedure init;
begin
        fillchar(dd,sizeof(dd),false);
        spt:=0;
        ch:='';
        kq[0]:=chr(ord('a')-1);
end;


procedure sapxep;
var     min,i,j:byte;
        tam:char;
begin
        for i:=1 to length(s)-1 do
                begin
                        min:=i;
                        for j:=min+1 to length(s) do
                                if s[min]>s[j] then
                                        min:=j;
                        tam:=s[min];
                        s[min]:=s[i];
                        s[i]:=tam;
                end;
end;

procedure try(i:byte);  // lan chon thu i
var j:byte;
begin
        if i-1=length(s) then
                begin

                                begin
                                        inc(spt);
                                        kq[spt]:=ch;
                                        writeln(f,ch);
                                end;
                end
        else
                for j:=1 to length(s) do
                        if not dd[j] then
                                begin
                                        dd[j]:=true;
                                        ch:=ch+s[j];
                                        if ch>kq[spt] then
                                                try(i+1);
                                        delete(ch,length(ch),1);
                                        dd[j]:=false;
                                end;
end;


procedure hvlap;
var     i,vt:byte;
        sum:longint;
        phanmau:longint;
begin
        vt:=1;    phanmau:=1;
        while vt<=length(s) do
                begin
                        i:=1;
                        while (s[vt]=s[vt+1]) and (vt<=length(s)) do
                                begin
                                        inc(i);
                                        inc(vt);
                                end;
                        phanmau:=phanmau*gt[i];
                        inc(vt);
                end;
        sum:=gt[length(s)] div phanmau;
        writeln(f,sum);
end;

begin
        docfile;
        assign(f,fo); rewrite(f);
        sapxep;
        hvlap;
        try(1);
        close(f);
end.

b. Code tham khảo 2

Code bổ sung (26/4/15):

const
        maxn    =       9;
        gt      :       array[0..maxn] of longint =
                (1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880);
var
        n       :       longint;
        s       :       string;
        fi      :       text;
        tmp     :       char;


procedure resort;
var     i, j : longint;
        tmp : char;
begin
        for i:= 1 to n-1 do
        for j:= i+1 to n do
        if s[i] > s[j] then
        begin
                tmp:= s[i]; s[i]:= s[j]; s[j]:= tmp
        end
end;

procedure count;
var     i, c, t : longint;
begin
        i:= 1; t:= 1;
        while i <= n do
        begin
                c:= 1;
                while ((s[i]=s[i+1]) and (i <= n)) do
                begin
                        inc(i); inc(c)
                end;
                t:= t * gt[c];
                inc(i)
        end;
        writeln(fi, gt[n] div t)
end;

procedure swap(var a, b : char); inline;
var
        tmp : char;
begin
        tmp:= a; a:= b; b:= tmp
end;

procedure generate;
var     i, j, k, a, b : longint;
begin
        repeat
                writeln(fi, s);
                i:= n-1;
                while (i>0) and (s[i] >= s[i+1]) do
                        dec(i);
                if i>0 then
                begin
                        k:= n;
                        while (k>0) and (s[k] <= s[i]) do
                                dec(k);
                        if k=0 then
                                exit;
                        swap(s[i], s[k]);
                        a:= i+1; b:= n;
                        while a<b do
                        begin
                                swap(s[a], s[b]); inc(a); dec(b)
                        end
                end;
        until   i=0;
end;

begin
        readln(s);
        n:= length(s);
        resort;
        assign(fi, ''); rewrite(fi);
        count;
        generate;
        close(fi);
readln
end.

Trả lời

Email của bạn sẽ không được hiển thị công khai. Các trường bắt buộc được đánh dấu *