Diễn đàn tin học Văn Lang - Vạn Ninh
Chào mừng bạn đến với Diễn đàn Tin học Văn Lang - Vạn Ninh của chúng tôi !
Hãy đăng nhập hoặc đăng kí tài khoản để trải nghiệm nhiều điều thú vị tại đây !
Thân ái !

Diễn đàn tin học Văn Lang - Vạn Ninh

Nơi trao đổi thông tin, tăng cường hợp tác, giải đáp những vướng mắc khi học lập trình Pascal
 
Trang ChínhCalendarTrợ giúpTìm kiếmThành viênNhómĐăng kýĐăng Nhập

Share | 
 

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

Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down 
Tác giảThông điệp
Admin
Admin
avatar

Posts : 113
Danh tiếng : 5
Join date : 10/11/2014
Age : 16

Bài gửiTiêu đề: Bài tập xâu (2)   16/1/2015, 06:04



Bài 1

Uses Crt;
Var S1,S2,S : String;
L1,L2,i,j,vt,d: Byte;
Procedure BonPhepCoBan;
Function Dodai(S : String) : Byte;
Begin
Dodai := Ord(S[0]);
End;
Function Noi(S1,S2 : String): String;
Var i : Byte;
S : String;
Begin
S := '';
For i:=1 to Dodai(S1) do S := S+S1[i];
For i:=1 to Dodai(S2) do S := S+S2[i];
Noi := S;
End;
Function VitriT(S1,S2 : String) : Byte;
Var i,j,p,L1,L2 : Byte;
Begin
L1 := Dodai(S1);
L2 := Dodai(S2);
p := 1;
i := 1;
j := 1;
While (i<=L1) and (j<=L2) do
Begin
If S1[i]=S2[j] then
Begin
Inc(i);
Inc(j);
End
Else
Begin
Inc(p);
j := p;
i := 1;
End;
If i>L1 then VitriT := p Else VitriT := 0;
End;
End;
Function VitriP(S1,S2 : String) : Byte;
Var i,j,p,L1,L2 : Byte;
Begin
L1 := Dodai(S1);
L2 := Dodai(S2);
p := L2;
i := L1;
j := L2;
While (i>=1) and (j>=1) do
Begin
If S1[i]=S2[j] then
Begin
Dec(i);
Dec(j);
End
Else
Begin
Dec(p);
j := p;
i := L1;
End;
If i<1 then VitriP := p-L1+1 Else VitriP := 0;
End;
End;
Function Saochep(S : String;vitri,dodai : Byte) : String;
Var S1 : String;
Begin
S1 := '';
For i:=1 to dodai do
S1 := S1 + S[vitri+i-1];
Saochep := S1;
End;
Begin
Clrscr;
S2 := 'LOP 10 CHUYEN TIN HOC TIN HOC';
S1 := 'TIN';
Writeln(S1,' : ',dodai(S1));
Writeln(S2,' : ',dodai(S2));
S := Noi(S1,S2);
Writeln(S, ' : ',dodai(S));
Writeln('Vi tri cua "',S1,'" trong "',S2,'" trai --> phai la ',vitriT(S1,S2));
Writeln('Vi tri cua "',S1,'" trong "',S2,'" phai --> trai la ',vitriP(S1,S2));
Vt := 8;
D := 6;
Writeln('Copy mot xau con cua "',S2,'" tu vi tri ',vt,' voi do dai ',d);
Writeln( 'duoc ',Saochep(S2,Vt,D));
End;
BEGIN
Clrscr;
BonPhepCoBan;
Readln;
END.

Bài 2
Uses Crt;
Const N = 75;
M = 10;
Var S,S1 : String;
L,L1 : Byte;
A : Array[0..255] of Byte;
Procedure NhapNgNh;
Var i,j : Byte;
Begin
Randomize;
S := '';
S1 := '';
For i:=1 to N do
Begin
j := Random(5);
S:=S+Char(65+j);
End;
For i:=1 to M do
Begin
j := Random(5);
S1:= S1+Char(65+j);
End;
Writeln('S = ',S);
Writeln('S1 = ',S1);
End;
Procedure Next;
Var k,j : Byte;
Ngung : Boolean;
Begin
L1 := Length(S1);
L := Length(S);
A[1] := 0;
k := 0;
j := 1;
While j<L1 do
Begin
Ngung := False;
While (k>0) and (Not Ngung) do
If S1[k] <> S1 [j] then k := A[k] Else Ngung := True;
Inc(k);
Inc(j);
If S1[k]=S1[j] then A[j] := A[k] Else A[j] := k;
End;
For j:=1 to L1 do Write(A[j]:4);
End;
Function Vt : Byte;
Var p,i,j : Byte;
Begin
p := 1;
i := 1;
j := 1;
While (i<=L1) and (j<=L) do
Begin
If S1[i]=S[j] then
Begin Inc(i);Inc(j); End
Else
Begin
Inc(p,i-A[i]);
If A[i] >0 then i := A[i]
Else
Begin
i := 1;
Inc(j);
End;
End;
If i>m then Vt := p Else vt := 0;
End;
End;
BEGIN
Clrscr;
S := 'AABCBABCAABCAABABCBA';
S1 := 'ABCAABABC';
Writeln(S);
Writeln(S1);
{ NhapNgNh;}
Next;
Writeln;
Writeln(Vt);
Readln;
END.

Thuật toán trên cỡ O(L). Vì vậy rất hiệu suất khi áp dụng so mẫu trên 2 mảng :

Uses Crt;
Const Max = 10000;
Var S,S1 : Array[1..Max] of Char;
L,L1 : Integer;
A : Array[0..Max] of Integer;
Procedure NhapFile;
Const Fi = 'somau.txt';
Var i,j,Li : Integer;
F : Text;
phu : String;
Begin
Assign(F,Fi);
Reset(F);
Li := 0;
While not SeekEof(F) do
Begin
Readln(F,phu);
If phu<>'*' then
Begin
j := Length(phu);
For i:=1 to j do S[Li+i] := phu[i];
Inc(Li,j);
End
Else
While not SeekEof(F) do
Begin
L := Li;
Li := 0;
Readln(F,phu);
j := Length(phu);
For i:=1 to j do S1[Li+i] := Phu[i];
Inc(Li,j);
L1 := Li;
End;
End;
Close(F);
For i:=1 to L do Write(S[i]);
Writeln;
For i:=1 to L1 do Write(S1[i]);
Writeln;
End;
Procedure Next;
Var k,j : Integer;
Ngung : Boolean;
Begin
A[1] := 0;
k := 0;
j := 1;
While j<L1 do
Begin
Ngung := False;
While (k>0) and (Not Ngung) do
If S1[k] <> S1 [j] then k := A[k]
Else Ngung := True;
Inc(k);
Inc(j);
If S1[k]=S1[j] then A[j] := A[k]
Else A[j] := k;
End;
For j:=1 to L1 do Write(A[j]:4);
End;
Function Vt : Integer;
Var p,i,j : Integer;
Begin
p := 1;
i := 1;
j := 1;
While (i<=L1) and (j<=L) do
Begin
If S1[i]=S[j] then
Begin
Inc(i);
Inc(j);
End
Else
Begin
Inc(p,i-A[i]);
If A[i] >0 then i := A[i]
Else
Begin
i := 1;
Inc(j);
End;
End;
If i>L1 then Vt := p Else vt := 0;
End;
End;
BEGIN
Clrscr;
NhapFile;
Next;
Writeln;
Writeln(Vt);
Readln;
END.
Về Đầu Trang Go down
Xem lý lịch thành viên http://forumpascalvanlang.forumvi.com
 
Bài tập xâu (2)
Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang 
Trang 1 trong tổng số 1 trang

Permissions in this forum:Bạn không có quyền trả lời bài viết
Diễn đàn tin học Văn Lang - Vạn Ninh :: Bài tập :: Xâu kí tự-
Chuyển đến