Ai pro Pascal xem giúp em bài này đã đúng chưa

Cô cho em bài làm qua tết như sau. Anh chị nào xem giúp em với.
Tìm chuỗi:
Cho một xâu S và một xâu T chỉ gồm các ký tự thường và hoa từ ‘a’ tới ‘z’ và các số từ ‘0’ tới ‘9’. Viết chương trình cho biết xâu T có phải là xâu con (liên tục) của S hay không. Nếu là xâu con thì cho biết vị trí đầu tiên bắt đầu xuất hiện xâu T trong S.

Input: BAI1.INP
Gồm 2 dòng:
Dòng 1: xâu S có độ dài tối đa m, với 0 < m <= 10^6.
Dòng 2: xâu T có độ dài tối đa n, với 0 < n <= 10^6.

Output: BAI1.OUT
Nếu xâu T không phải là xâu con của S thì ghi -1. Ngược lại thì ghi ra chỉ số của vị trí bắt đầu của xâu T ở trong S.

Ví dụ:
BAI1.INPBAI1.OUT
tettetdenroi
et		2
tetabcaabbcy
bcaat		-1

Em đã làm rồi mà không biết có trường hợp nào ct sai không. Ngoài ra, ai chỉ giúp em làm sao làm cho nó nhanh hơn. Em thấy nó chạy khá chậm. Chiều dài chuỗi lớn hơn 10000 là phần nâng cao mà ct em chạy không nổi.
Mã: 
var s,t : ansistring;
    i,j,vi_tri : longint;
    tim_duoc : boolean;
    fi,fo : text;
    
begin
    assign(fi, 'BAI1.INP');
    reset(fi);
    readln(fi, s);
    readln(fi, t);
    close(fi);
    assign(fo, 'BAI1.OUT');
    rewrite(fo);
    tim_duoc:=false;
    i:=1;
    j:=1;
    vi_tri:=1;
    while (i <= length(s)) do
        begin
            if (s[i] = t[j]) then
                begin
                    i:=i+1;
                    j:=j+1;
                end
            else
                begin
                    j:=1;
                    i:=i+1;
                    vi_tri:=i;
                end;
            if (j > length(t)) then
                begin
                    tim_duoc:=true;
                    writeln(fo, vi_tri);
                    break;
                end;
        end;
    if (tim_duoc = false) then
        writeln(fo, -1);
    close(fo);
end.
 
P

phamthanhnhan

(｡◕‿‿◕｡) づ
đây là code dư sức chạy tới 10^6 nhé
Mã: 
//code written by Phạm Thanh Nhân LHP
const fi='string.inp';
      fo='string.out';


var f:text;
    st,s,ss:ansistring; //max length=10^6
    n,i,j:longint; //do dai la 10^6


begin
    assign(f,fi);
    reset(f);
      readln(f,s);
      readln(f,ss);
    close(f);


    assign(f,fo);
    rewrite(f);
      j:=0; // co hieu
      for i:=1 to length(s)-length(ss)+1 do
        begin
          if s[i]=ss[1] then
            begin
              st:=s;
              delete(st,i,length(ss));
              insert(ss,st,i);
              if st=s then
                begin
                  writeln(f,i);


                  j:=1; // la da thuc hien
                  break;
                end;
            end;
        end;
      if j=0 then writeln(f,-1);
    close(f);
end.
 
N

nngoc

Em cám ơn anh. Em thử trường hợp sau thì ct chạy quá chậm. Có cách nào cho nó chạy nhanh hơn không? Mà code của em có đúng không? :too_sad:
Mã: 
ss:='1111111110';
s:='';
for i:=1 to 1000000 do
    s:=s+'1';
 
P

phamthanhnhan

(｡◕‿‿◕｡) づ
nngoc:
Em cám ơn anh. Em thử trường hợp sau thì ct chạy quá chậm. Có cách nào cho nó chạy nhanh hơn không? Mà code của em có đúng không? :too_sad:
Mã: 
ss:='1111111110';
s:='';
for i:=1 to 1000000 do
    s:=s+'1';
Nhấn để mở rộng...

mình chưa hiểu lắm, vì thuật toán là O(n) với n<=10^6 và các thao tác string cơ bản thì ko có chậm, test nào chậm bạn up lên mình xem thử với
 
N

nngoc

Em viết code tạo chuỗi s và ss bằng tay. Chuỗi s là 10^6 con số 1, chuỗi ss là '1111111110'. Em chạy hơn 1 phút chưa ra.
 
P

phamthanhnhan

(｡◕‿‿◕｡) づ
nngoc:
Em viết code tạo chuỗi s và ss bằng tay. Chuỗi s là 10^6 con số 1, chuỗi ss là '1111111110'. Em chạy hơn 1 phút chưa ra.
Nhấn để mở rộng...
do bạn dùng linear (tuyến tính), nếu mà bạn từng học qua binary search thì người ta tạo chuỗi không làm như vậy
Mã: 
//code linear tạo chuỗi length=1024
for i:=1 to 1024 do 
  s:=s+'1';

Mã: 
//code theo tư tưởng làm việc của binary search
s:='1';
for i:=1 to 10 do 
  s:=s+s;

đó là sự khác biệt của làm tuyến tính với theo tư tưởng của binary search
 
N

nngoc

Ý của em là: chuỗi s và ss được tạo như thế thì ct của anh chạy không ra kết quả. Em đã tạo được chuỗi s gồm 10^6 con số 1 rồi.
 
V

Vuh

Dùng hàm Pos(T,S) để kiểm tra vị trí xuất hiện của xâu T trong xâu S.
Nếu không tìm thấy thì trả về giá trị 0.
Code:
Mã: 
If pos(t,s)=0 then writeln('-1') else writeln(pos(t,s));
 
N

nngoc

Vuh:
Dùng hàm Pos(T,S) để kiểm tra vị trí xuất hiện của xâu T trong xâu S.
Nếu không tìm thấy thì trả về giá trị 0.
Code:
Mã: 
If pos(t,s)=0 then writeln('-1') else writeln(pos(t,s));
Nhấn để mở rộng...
Cô của em không cho dùng hàm có sẵn. :nherang:
 
V

Vuh

Bạn thử code này nhé, chạy đến 20000 mà chưa tới 1s đâu.
Mã: 
uses crt;
var
        s,t:ansistring;
        i:qword;
begin
        clrscr;
        {$ Tao xau S la 10000 ki tu }
        s:='';
        i:=0;
        while i<20000 do
                begin
                        inc(i);
                        s:=s+'a';
                end;
        writeln(length(s));
        t:='b';
        {write('Nhap s: ');
        readln(s);
        write('Nhap t: ');
        readln(t);}
        i:=1;
        while i<length(s) do
                begin
                        if copy(s,i,length(t))=t then
                                begin
                                        writeln(i);
                                        readln;
                                        exit;
                                end;
                        inc(i,1);
                end;
        writeln('-1');
        readln
end.
Ở đây mình tạo xâu S là 'aaa...' và tìm chữ 'b' trong xâu đó. Do vậy nên chương trình sẽ chạy hết cả xâu.
 
N

nngoc

Vuh:
Bạn thử code này nhé, chạy đến 20000 mà chưa tới 1s đâu.
Mã: 
uses crt;
var
        s,t:ansistring;
        i:qword;
begin
        clrscr;
        {$ Tao xau S la 10000 ki tu }
        s:='';
        i:=0;
        while i<20000 do
                begin
                        inc(i);
                        s:=s+'a';
                end;
        writeln(length(s));
        t:='b';
        {write('Nhap s: ');
        readln(s);
        write('Nhap t: ');
        readln(t);}
        i:=1;
        while i<length(s) do
                begin
                        if copy(s,i,length(t))=t then
                                begin
                                        writeln(i);
                                        readln;
                                        exit;
                                end;
                        inc(i,1);
                end;
        writeln('-1');
        readln
end.
Ở đây mình tạo xâu S là 'aaa...' và tìm chữ 'b' trong xâu đó. Do vậy nên chương trình sẽ chạy hết cả xâu.
Nhấn để mở rộng...
Em cám ơn anh. Khi S và đặc biệt là T dài ra thì hình như chạy không nổi. Em thử trường hợp chuỗi S lên 10^5 và T là 20000 thì thấy chậm hẳn.
 
V

Vuh

Code của anh vẫn chạy bình thường mà, đã tăng S lên 10^5 và T lên 20 000 vẫn chỉ xấp xỉ 1s thôi.
Mã: 
uses crt;
var
        s,t:ansistring;
        i:qword;
begin
        clrscr;
        s:='';
        i:=0;
        while i<100000 {10^5} do
                begin
                        inc(i);
                        s:=s+'a';
                end;
        i:=0;
        while i<20000 do
                begin
                        inc(i);
                        t:=t+'b';
                end;
        {write('Nhap s: ');
        readln(s);
        write('Nhap t: ');
        readln(t);}
        i:=1;
        while i<length(s) do
                begin
                        if copy(s,i,length(t))=t then
                                begin
                                        writeln(i);
                                        readln;
                                        exit;
                                end;
                        inc(i,1);
                end;
        writeln('-1');
        readln
end.
Mà hình như là đọc từ file với dữ liệu quá lớn sẽ rất lâu, file chứa cả S và T tổng cộng là 100 000+20 000=120 000 byte=120 MB.
Bạn thử bỏ phần đọc file xem tốc độ có được cải thiện không.
 
T

tengiday

Happy life
@phamthanhnhan
Cách làm của bạn là O(n^2), không phải O(n).
[ah]
insert và delete: ansistring được biểu diễn bởi array of char, nên nếu muốn chèn / xóa 1 phần tử / chuỗi vào thì phải dịch chuyển những phần tử sang vị trí khác. Rõ ràng chi phí dịch chuyển như thế là O(n). Ngoài ra còn phải tính cả trường hợp xấu nhất là cần khai báo array lớn hơn nếu không đủ chỗ chứa. Khi đó, phải copy toàn bộ array cũ sang array mới.
Bạn có thể thử đoạn code nho nhỏ sau. Mỗi lần mình gấp đôi chiều dài của chuỗi rồi gọi ‘insert’. Nếu 2 functions là O(1) time thì sẽ không phụ thuộc vào chiều dài của chuỗi. Tuy nhiên, kết quả là phủ định.
Mã: 
uses DateUtils, SysUtils;
var i : longint;
    s : ansistring;
    start : TDateTime;
    
BEGIN
    s := '1';
    for i := 1 to 20 do
        s := s + s;
    for i := 1 to 4 do
        begin
            s := s + s;
            start := Now;
            insert('2', s, 1);
            writeln('N = ', length(s), '   Time = ', MilliSecondsBetween(Now, start));
        end;
END.

So sánh 2 chuỗi (s = st): Cái này càng không thể là O(1) được.
[/ah]

@Vuh
Cách làm của bạn chạy tốt nếu chuỗi T không quá dài, nhưng nếu chuỗi T dài (và kết hợp với S) thì sẽ không chạy nhanh tới 10^6 nữa. Bạn thử đoạn code này sẽ thấy. Chuỗi T được chọn một cách khéo léo.
[ah]
Mã: 
uses DateUtils, SysUtils;
var i, j : longint;
    s, t : ansistring;
    start : TDateTime;
    
BEGIN
    s := '';
    for i:=1 to 100000 do
        s := s + '1';
    t := '';
    for i:=1 to 20000 do
        t := t + '1';
    t := t + '0';
    
    start := Now;
    i:=1;
    while i<length(s) do
        begin
            if copy(s,i,length(t))=t then
                begin
                    writeln(i);
                    readln;
                    exit;
                end;
            inc(i,1);
        end;
    writeln('-1');
    writeln('Time = ', MilliSecondsBetween(Now, start));
END.
[/ah]
So sánh 2 chuỗi: thao tác này khá đắt bởi vì trường hợp tệ nhất phải quét toàn bộ chuỗi. Thuật toán của bạn vẫn có độ phức tạp O(n^2).
Ngoài ra, 120 000 byte ~ 120 KB, chứ ko phải 120 MB. Mega ~ triệu, Kilo ~ nghìn. Nếu 2 chuỗi S và T có độ dài 10^6 thì file input chỉ cỡ 2 MB.

@nngoc (the OP)
Đầu tiên, đoạn code của bạn chưa chính xác ở test sau:
[ah]
Mã: 
S := '99987';
T := '9987';
[/ah]
Nguyên nhân sai: ở trong vòng ‘while’ loop:
[ah]
Mã: 
j:=1;
[COLOR=#ff0000][B]i:=i+1;[/B][/COLOR]
vi_tri:=i;
[/ah]
Đây là bạn di chuyển i sang vị trí mới nếu 2 chuỗi là mismatched. Tuy nhiên khi đó giả sử đã chạy gần hết chuỗi T thì khi di chuyển sang i + 1 thì rõ ràng bạn đã bỏ qua một đoạn vị trí bắt đầu trong S để so sánh (Bạn chạy debug sẽ hiểu rõ tại sao). Bạn cần sửa lại:
[ah]
Mã: 
j:=1;
vi_tri:=vi_tri+1;
i:=vi_tri;
[/ah]
Tuy nhiên, cách làm này cũng có độ phức tạp O(n^2).

Như vậy làm bài này thế nào?
Với bài substring search này, bạn có thể dùng thuật toán KMP để giải. Thuật toán có độ phức tạp O(n + m), linear, là một thuật toán rất nổi tiếng. Cho dù 10^6 chạy trên máy mình cũng chưa tới 1 s.
Điểm quan trọng của thuật toán là mảng prefix. Chúng ta lưu 2 biến i và j để đánh dấu vị trí so sánh trong chuỗi S và T. Nếu S <> T[j] thì phải chọn lại i và j. Chọn như thế nào thì phải nhìn mảng prefix F.
F[j] = vị trí cần quay lại để search trong T nếu S <> T[j]. Nói một cách khác, F[j] = chiều dài lớn nhất của prefix của T mà cũng là suffix của T kết thúc tại vị trí trước j với j > 1, và chúng ta gán F[1] := 0.

Đoạn code của cả 3 bạn khi gặp mismatched đều implicitly/explicitly gán j := 1 cả, tức là so sánh lại từ đầu. Điều này dẫn đến so sánh không cần thiết. Thuật toán này sẽ gán j := F[j - 1],; đây là điểm hay của thuật toán.
Hy vọng mình chuyển từ C sang ko bị nhầm index :-(
[ah]
Mã: 
var f : array[0..1000000] of longint;
    s, t : ansistring;

function substring_search(s, t : ansistring) : longint;
var i, j : longint;
    
begin
    // tạo mảng prefix f.
    f[0] := 0;
    f[1] := 0;
    j := 1; i := 2;
    while (i <= length(t)) do
        if (t[i] = t[j]) then
            begin
                f[i] := j;
                inc(i);
                inc(j);
            end
        else if (j > 0) then
            j := f[j]
        else
            begin
                f[i] := 0;
                inc(i);
                inc(j);
            end;

    i := 1; j := 1;
    while (i <= length(s)) do
        begin
            if (s[i] = t[j]) then
                begin
                    inc(i);
                    inc(j);
                end
            else if (j > 0) then
                j := f[j - 1]
            else
                begin
                    inc(i);
                    j := 1;
                end;
            if (j > length(t)) then
                exit(i - length(t));
        end;
    exit(-1);
end;

BEGIN
    readln(s);
    readln(t);
    writeln(substring_search(s, t));
END.
[/ah]
@nngoc: Topic "Chuỗi con liên tục" của bạn là ứng dụng của KMP đấy. Nếu bạn hiểu được mảng prefix, F thì bài đó chỉ cần 1 dòng lệnh nữa là xong.
 
N

nngoc

Em cám ơn anh tengiday nhiều lắm lắm lắm luôn. Đọc bài của anh mà em chỉ có 1 chữ "phục". Để em cố gắng tiêu hóa KMP Em làm tay thì thấy nó khá dễ hiểu. Anh có thể giúp em xem bài này được không ạ? Để em cố làm bài "Chuỗi con liên tục".
HTML: 
https://vfo.vn/t/showthread.php?105732-Ai-pro-Pascal-giai-giup-em-bai-Thu-thach-nay
Một lần nữa, em xin cám ơn.
 
Đăng nhập bằng tài khoản VFO hoặc Google

Bài viết mới nhất

Thống kê

Chủ đề
100,681
Bài viết
467,463
Thành viên
339,834
Thành viên mới nhất
Banchaidienhcm

Bài viết được quan tâm nhiều

Top