Bài tập xâu (4)

Bài 1 Cho xâu A gồm N kí tự chữ số (1<N<10). Xâu B gọi là một thuận thế của A được xây dựng như sau :
B[i] là chữ số thể hiện số các chữ số của xâu A nằm ở bên trái A[i] và nhỏ hơn A[i] . Thí dụ : A=‘264153’ thì thuận thế là B=‘011032’.Rõ ràng B[1]=‘0’ là không cần thiết , vì vậy có thể định nghĩa thuận thế thu gọn là B=‘11032’ . Trong một số trường hợp có thể bỏ thêm 1 số không nữa , vẫn có thể tìm lại hoán vị nhỏ nhất trong các hoán vị tạo ra loại thuận thế thu gọn kiểu này . Thí dụ : Thuận thế thu gọn (bỏ 2 chữ số 0 ) là ‘1132’
Hoán vị nhỏ nhất tạo lại là : ‘253641’
Lập chương trình thực hiện các yêu cầu :
a ) Nhập vào 1 hoán vị , tìm thuận thế
b ) Nhập vào 1 thuận thế , tìm lại hoán vị
c ) Nhập vào 1 thuận thế thu gọn ( Kiểu bỏ 2 số 0 ) , tìm hoán vị nhỏ nhất có thuận thế thu gọn này .

Bài 2 Tạo tất cả các hoán vị của N ( N =9 ) số 1,2,3,4,5,6,7,8,9 bằng cách tạo một hoán vị ban đầu là S1=‘123456789’ sau đó tạo hoán vị ở vị trí tự điển tiếp theo S2=‘123456798’ ...
Ghi các hoán vị vào File .
Tạo một hoán vị tiếp theo từ hoán vị S qua các bước :
+ Bước 1 : i=N . Trong khi S[i-1]>S[i] thì giảm i xuống 1 đơn vị .
+ Bước 2 : Nếu i=1 thì kết thúc chương trình
+ Bước 3 : Nếu i>1 , giảm i xuống 1 đơn vị, cho j=N , trong khi S[j]<S[i] thì giảm j xuống 1 đơn vị
+ Bước 4 : Tráo giá trị S[i] và S[j] . Tăng i lên 1 đơn vị
+ Bước 5 : Lấy đối gương đoạn từ i đến N ( Tráo S[i+k] và S[N-k] cho nhau , với k thoả mãn 2*k < N-i)
+ Bước 6 : Nếu chưa kết thúc chương trình thì quay về bước 1 .

Bài 3 Tính N! ( N<=2000)
Lời giải
Bài 1 :
Uses Crt;
Var N : Byte;
A,LA,HV,HVmin : String;
Procedure Nhaphoanvi;
Var i : Byte;
Begin
Write('Nhap vao 1 hoan vi 1..n : ');
Readln(A);
N := Length(A);
End;
Procedure TaoThuanthe;
Var i,j : Byte;
Begin
For i:= N downto 1 do
Begin
For j:= 1 to i-1 do
If A[j]>A[i] then A[j] := Pred(A[j]);
A[i] := Pred(A[i]);
End;
End;
Procedure TaoHvi(Var A : String);
Var i,j : Byte;
Begin
For i:=1 to N do
Begin
A[i] := Succ(A[i]);
For j:=1 to i-1 do
If A[j]>=A[i] then A[j] := Succ(A[j]);
End;
End;
Procedure TaoHvi2;
Var i,j : Byte;
Begin
Write('Nhap thuan the thu gon : ');
Readln(A);
LA :='0'+A;
N := Length(LA)+1;
HVmin := '';
For i:=1 to N do HVmin := HVmin+'9';
i := 2;
While i<= N do
Begin
A := LA;
Insert('0',A,i);
TaoHvi(A);
If A<HVmin then HVmin := A;
Inc(i);
End;
End;
BEGIN
Clrscr;
Nhaphoanvi;Writeln;
TaoThuanthe;Writeln;
Write('Thuan the la : ',A);Writeln;
TaoHvi(A);
Write('Hoan vi tao lai la : ',A);Writeln;
TaoHvi2;
Write('Hoan vi nho nhat tao lai : ',HVmin);
Readln;
END.

Bài 2 :
Uses Crt;
Const N = 7;{Chỉ nên chọn n<=9 , khi n=10 chạy quá lâu vì ghi File chứa 3628800 hoán vị }
Fo = 'Hvi.txt';
Var A : String;
i : Byte;
F : Text;
Dem : LongInt;
Function Tim ( Var A : String): Boolean;
Var i,j,k : Byte;
Coc : Char;
Begin
i:= N;
While (i>1) and (A[i-1]>A[i]) do Dec(i); { Leo dốc }
If i=1 then
Begin
Tim := True;
Exit;
End;
j := N;
Dec(i); { i hố sâu dưới dốc }

{ Tìm vị trí đầu tiên trên sườn dốc không thấp hơn hố sâu }
While (A[j]<A[i]) do Dec(j);


{ Tráo điểm trên sườn dốc và hố sâu }
coc := A[i];
A[i] := A[j];
A[j] := coc;


Inc(i);
k := 0;

{ Lấy đối xứng gương đoạn từ i tới N }
While (i+2*k<=N) do
Begin
coc := A[i+k];
A[i+k] := A[N-k];
A[N-k] := coc;
Inc(k);
End;

Writeln(F,A);
Tim := False;
End;
BEGIN
Clrscr;
A :='123456789';
A := copy(A,1,N);
dem := 0;

Assign(F,Fo);
Rewrite(F);
Writeln(F,A);
Repeat
Inc(dem);
Until tim(A);

Writeln(F,dem);
Close(F);
Writeln('Xong');
Readln
END.

Uses Crt;
Var A : Array[1..9000] of string[1];
n,dem : Word;
Procedure Nhapn;
Begin
Clrscr;
Repeat
Write(' cho biet gia tri cua n (n!) ');{$I-} Readln(n);{$I+}
Until (IOresult=0) and (n<=2000);
End;
Procedure Tinh;
Var du,nho,nho1,so,so1,cod,i,j,k : Integer;
nh,c:string[1];
Begin
Writeln('Please wait ... ');
For i:=1 to 8999 do a[i]:='0';
a[9000]:='1';
dem:=8999;
nho:=0;
For i:=1 to n do
Begin
For j:=9000 downto dem-4 do
If a[j]<>'0' then
Begin
val(a[j],so1,cod);
so :=so1*i+nho;
nho:=so div 10;
du:=so mod 10;
str(du,c);a[j]:=c;
End Else
Begin
nho1:=nho mod 10;
str(nho1,nh);
a[j]:=nh;
nho:=nho div 10;
End;
dem:=dem-4;
Repeat
Inc(dem);
Until a[dem]<>'0';
End;
End;
Procedure Hien;
Var i : Integer;
Begin
Clrscr;
Write(' ',n,' ! = ');
For i:=dem-1 to 9000 do
Begin
If (i-dem+2) mod (80*23) = 0 then Readln ;
Write(a[i]);
End;
Writeln;
End;
Procedure Thongbao;
Begin
Gotoxy(20,25);
Write('ESC to quit . Press any key to continue ... ');
End;
BEGIN
Repeat
Nhapn;
Tinh;
Hien;
Thongbao;
Until Readkey=#27;
END.