- Ebook Giải thuật và lập trình Lê Minh Hoàng
- Các thuật toán sắp xếp trong Pascal

Xâu thuần nhất (Giải nén xâu trong pascal)



Xâu kí tự thuần nhất được định nghĩa là xâu chỉ bao gồm các chữ cái tiếng anh. Một xâu thuần nhất có thể được viết thu gọn, bao gồm các số thứ tự kèm theo tần số xuất hiện liên tiếp của nhóm đó!
VD: AACCBBB<-->A2B2C3
XCAABAABAABCCADADCADCAABAABCCADADY<-->X(C(A2B)3C2(AD)2)2Y
(AB)2(QXA)3<-->ABABQXAQXAQXA
Hãy viết chương trình thu gọn và giải mã (hay nén và giải nén) xâu.


Thuật toán dưới đây là quá trình nén xâu.

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.


LH7 nói...

cái này giống đề HSG tỉnh Nghệ An phải ko ạ?


lúc 20:21 3 tháng 2, 2013
Nặc danh nói...

bài này đâu cần làm dài vậy ~~


lúc 07:54 12 tháng 12, 2013
Unknown nói...

thế mn có bit cách nào ABABQXAQXAQXA<-->(AB)2(QXA)3 không chỉ em với :(


lúc 20:55 4 tháng 3, 2014
Nặc danh nói...

giải nén 1 xâu kí tự mà ko dùng chương trình con làm sao z chỉ mình với


lúc 12:26 12 tháng 10, 2015
Nặc danh nói...

à, bài này làm rồi, không cần chương trình con cũng làm đc, đâu cần dài như vậy


lúc 16:45 15 tháng 2, 2016
Nặc danh nói...

chỉ cần khai báo hai xâu, một xâu là nhập vào, xâu kia là xâu kq
dùng vòng for..to..do.. để duyệt từng kí tự từ đầu đến cuối trong xâu nhập, với mỗi lần duyệt nếu kí tự sau giống kí tự trc thì tăng biến đếm, nếu kí tự sau khác kí tự trước thì viết kí tự trước vào xâu kq, viết biến đếm vào xâu kq rồi gán biến đếm bằng 1, lại so sánh tiếp cho đến hết xâu


lúc 16:55 15 tháng 2, 2016
Unknown nói...
Nhận xét này đã bị tác giả xóa.
Nặc danh nói...

còn bị lỗi


lúc 19:40 16 tháng 7, 2018

Đăng nhận xét

Thành viên Blog

Tổng số lượt xem trang

Translate

Return to top of page Copyright © 2012 | Theme by Hack Tutors. Cung cấp bởi Blogger.
Các code pascal trong blog được sưu tầm, lựa chọn sao cho tối ưu nhất. Cảm ơn các tác giả đã viết thuật toán.