2000 - ĐẢO CHỮ CÁI{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T...

Bài 46/2000 - Đảo chữ cái

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+,Y+}

{$M 16384,0,655360}

(*Du lieu vao: file 'inp.txt' voi cac tu khac nhau, moi tu ghi o mot dong;

Du lieu ra: file 'out.txt' *)

PROGRAM Sinh_hoan_vi;

USES Crt;

CONST

MAX = 100;

INP = 'inp.txt';

OUT = 'out.txt';

TYPE

STR = array[0..max] of char;

VAR

s :str;

f,g :text;

n :longint; { so luong tu}

time:longint ;

PROCEDURE Nhap_dl;

Begin

Assign(f,inp);

Assign(g,out);

Reset(f);

Rewrite(g);

Readln(f,n);

End;

PROCEDURE DocDay(var s:str);

Fillchar(s,sizeof(s),chr(0));

While not eoln(f) do

begin

s[0]:=chr(ord(s[0])+1);

read(f,s[ord(s[0])]);

end;

PROCEDURE VietDay(s:str);

Var i :word;

For i:=1 to ord(s[0]) do Write(g,s[i]);

PROCEDURE Sap_xep(l,r:word);{ giai thuat Quicksort}

Var i,j :word;

tg,tam :char;

i:=l;j:=r;

tg:=s[(l+r) div 2];

Repeat

While ord(s[i]) < ord(tg) do inc(i);

While ord(s[j]) > ord(tg) do dec(j);

If i<=j then

begin

tam:=s[i];

s[i]:=s[j];

s[j]:=tam;

inc(i);

dec(j);

end;

Until i>j;

If j>l then Sap_xep(l,j);

If i<r then Sap_xep(i,r);

PROCEDURE Sinh_hv(s:str);

Var vti,vtj,i,j:word;

stop :boolean;

tam :char;

Writeln(g);

VietDay(s);

Stop:=true;

For i:= ord(s[0]) downto 2 do

If s[i] > s[i-1] then

begin

vti:=i-1;

stop:=false;

For j:=ord(s[0]) downto vti+1 do

If (ord(s[j])>ord(s[vti])) then

vtj:=j;

break;

tam:=s[vtj];

s[vtj]:=s[vti];

s[vti]:=tam;

For j:=1 to ((ord(s[0]) - (vti+1))+1) div 2 do

tam:=s[vti+j];

s[vti+j]:=s[ord(s[0])-j+1];

s[ord(s[0])-j+1]:=tam;

Writeln(g);

VietDay(s);

break;

end;

Until stop;

PROCEDURE Xu_ly;

Var i:longint;

For i:=1 to n do

begin

DocDay(s);

readln(f);

Sap_xep(1,ord(s[0]));

Sinh_hv(s);

Writeln(g);

end;

Close(f);

Close(g);

BEGIN

Nhap_dl;

Xu_ly;

END.

(Lời giải của bạn Nguyễn Việt Bằng - Lớp 10 Tin - Trường phổ thông Năng Khiếu - ĐHQG TPHCM)