codeturbopascal Admin
Tổng số bài gửi : 22 Danh vọng : 64 Được thank : 7 Ngày Tham gia : 19/04/2013 Tuổi : 27 Đến từ : Quảng trị Thú Cưng :
| Tiêu đề: Giải nén xâu trong pascal Sun Apr 21, 2013 2:25 pm | |
| - Code:
-
program xau_thuan_nhat; uses crt; var s,ss,st,si:string; i,j,l:integer; function kttn(s:string):boolean; var x:char; ok:boolean; begin kttn:=true; for i:=1 to length(s) do s[i]:=upcase(s[i]); for i:=1 to length(s) do begin ok:=false; for x:='A' to 'Z' do if s[i]=x then ok:=true; if not ok then begin kttn:=false;break;end; end; end; procedure nen(s:string;var st:string); begin ss:=''; while s<>'' do begin i:=1; while (s[i+1]=s[1])and(i<length(s)) do inc(i); if i>1 then begin str(i,si); ss:=ss+s[1]+si; end else ss:=ss+s[1]; delete(s,1,i); end;
s:=ss;l:=2; while l<length(s) do begin i:=1; while i<=length(s)-l do begin si:=copy(s,i,l); j:=i+l; ss:=copy(s,j,l); while ss=si do begin j:=j+l; ss:=copy(s,j,l); end; if j=i+l then inc(i) else begin str((j-i)div l,ss); delete(s,i,j-i); si:='('+si+')'+ss; insert(si,s,i); i:=i+l+2+length(ss); end; end; inc(l); end; st:=s; end; function ktcd(st:string):boolean; begin ktcd:=false; for i:=1 to length(st) do if st[i]='(' then begin ktcd:=true; break; end; end; procedure giainen(st:string;var s:string); var d,c:byte; code:integer; begin while ktcd(st) do begin i:=1; c:=0; while st[i]<>'(' do inc(i); d:=1; j:=i+1; while c<d do begin inc(j); if st[j]='(' then inc(d); if st[j]=')' then inc(c); end; si:=copy(st,i,j-i+1); delete(st,i,j-i+1); delete(si,1,1); delete(si,length(si),1); j:=i; while st[j+1] in['0'..'9'] do inc(j); ss:=copy(st,i,j-i+1); delete(st,i,j-i+1); val(ss,l,code); for j:=1 to l do insert(si,st,i); end; i:=1; while i<=length(st) do begin inc(i); if st[i] in['0'..'9'] then begin j:=i; while st[j+1] in['0'..'9'] do inc(j); ss:=copy(st,i,j-i+1); delete(st,i,j-i+1); val(ss,l,code); ss:=st[i-1]; for j:=1 to l-1 do insert(ss,st,i); i:=i+l-1; end; end;
s:=st; end; begin clrscr; write('nhap chuoi: ');readln(s); if kttn(s) then begin nen(s,st); writeln('Chuoi sau khi nen la: ',st); giainen(st,s); writeln('Chuoi sau khi giai nen la: ',s); end else write('Xau ko thuan nhat.'); readln; end. | |
|