Mam problem, napisałam program i ... wywala się.
Potrzebuję go na jutro, mógłby ktoś pomóc mi znaleźć błąd?
Oto treść zadania:
Program powinien wyszukac wszystkie wystapienia danego wzorca w tekscie (w postaci
tekstu pasujacego do wzorca oraz indeksu poczatku wzorca w tekscie). Tekst jest ciagiem
małych liter alfabetu angielskiego. Wzorzec dodatkowo moe zawierac trzy inne znaki:
? – oznacza pojedynczy dowolny znak
- oznacza ciag 0 lub wiecej znaków
- oznacza ciag 1 lub wiecej znaków
Załoenia:
- uytkownik podaje maksymalna długosc znalezionego wzorca
- we wzorcu suma wystapien znaków + oraz * jest co najwyej równa 1.
Przykład:
Dane wejsciowe: ababa – tekst, 3 – maksymalna długosc tekstu
Wzorzec: a+
Dane wyjsciowe: (ab, 1), (aba, 1), (ab, 3), (aba, 3)
program Wzorzec_program;
uses
crt;
var
tekst, wzorzec, wzorzec1, wzorzec2 : string; //tekst(w którym wyszukujemy), wzorzec(co wyszukujemy), wzorzec1(przed znakiem), wzorzec2 (po znaku)
tekstdl, wzorzecdl, MAX, k, i, plus, razy : integer; // tekstdl(dlugosc tekstu) wzorzecdl(dlugosc wzorca), plus(+), razy(*), MAX(maks. dlugosc wzorca)
indeks : array[0..255] of integer; // i(poczatek wzorca) k(koniec wzorca)
procedure pobierz_dane;
begin
writeln('------------------------------------------------');
writeln('Pogram "Wyszukiwanie wzorca w tekscie"');
writeln('------------------------------------------------');
writeln;
write('Podaj tekst: ');
Readln(tekst);
write('Podaj wzorzec: ');
Readln(wzorzec);
MAX := 1;
k := 1;
plus := 0;
razy := 0;
if length(tekst) < length(wzorzec) then // teskt musi byc dluzszy od wzorca
begin
writeln('BLAD. Wzorzec dluzszy od tekstu.');
writeln;
pobierz_dane;
end;
if (length(tekst) = 0) or (length(wzorzec) = 0) then // nie można nic nie wpisac
begin
writeln('BLAD. Niepoprawne dane.');
writeln;
pobierz_dane;
end;
if wzorzec = '?' then // wzorzec nie moze być znakiem ?, nieskonczenie wiele wyszukań
begin
writeln('BLAD. To nie ma sensu');
writeln;
pobierz_dane;
end;
tekstdl := length(tekst);
wzorzecdl := length(wzorzec);
for i := 1 to wzorzecdl do
begin
if wzorzec[i] = '+' then
begin
plus := i;
write('Podaj maksymalna dlugosc znalezionego wzorca: ');
Readln(MAX); // podawanie max dlugosci wzorca
if MAX < wzorzecdl then
begin
writeln('BLAD. Podana dlugosc musi byc wieksza lub rowna dlugosci wzorca'); // maksymalna dl. nie moze byc mniejsza niz wpisana we wzorcu liczba znakow
writeln;
pobierz_dane;
end;
end;
if wzorzec[i] = '*' then
begin
razy := i;
write('Podaj maksymalna dlugosc znalezionego wzorca: ');
Readln(MAX);
if MAX<(wzorzecdl - 1) then
begin
writeln('BLAD. Podana dlugosc musi miec wielkosc minimum (dlugosc wzorca-1)');
writeln;
pobierz_dane;
end;
end;
end;
end;
procedure szukaj_wzorca(i, j : integer); // poruszanie się po tablicy w poszuiwaniu znaków
begin
repeat
if (tekst[i] = wzorzec[j]) or (wzorzec[j] = '?') then // gdy wzorzec=tekst lub ?...
begin
inc(i); // ...przechodzimy komórkę dalej w tablicy tekstu i wzorca.
inc(j);
end
else // gdy nie...
begin
i := i - j + 2; // w tekscie cofamy się do momentu sprzed sprawdzania
j := 1; // ustawiamy się na początku wzorca.
end; // dopóki tekst lub wzorzec się nie skończą ^^
until (i > tekstdl) or (j > wzorzecdl);
if j > wzorzecdl then // Jeżeli wzorzec się skończy
begin
indeks[k] := i - wzorzecdl;
inc(k);
szukaj_wzorca(i - wzorzecdl + 1, 1); // szukamy ponownie ;)
end;
end;
procedure wyniki; // wypisywanie wyników wyszukiwania.
var
i, j : integer; // i(indeks początku wzorca w tekscie) j(konkretne miejsce we wzorcu)
begin
writeln;
writeln('Wyniki dla wzorca w indeksie: ');
if k > 1 then
begin
for i := 1 to (k - 1) do
begin
write('(');
for j := 1 to wzorzecdl do
begin
if wzorzec[j] = '?' then
write(tekst[indeks[i] + j - 1])
else
write(wzorzec[j])
end;
write(', ', indeks[i], '), ');
end;
end
else
writeln('Nie znaleziono wzorca');
end;
function szukajka(var w, t : string; p : integer) : integer; // w(wzorzec), t(tekst), p(miesjce w tekcie), j(miejsce we wzorcu)
var
j : integer;
begin
j := 1;
if w = '' then
szukajka := p
else
begin
repeat
if (t[p] = w[j]) or (w[j] = '?') then
begin
inc(p);
inc(j);
end
else
begin
p := p - j + 2;
j := 1;
end;
until (p > length(t)) or (j > length(w));
if j > length(w) then
szukajka := p - length(w)
else
szukajka := 0;
end;
end;
procedure parametry;
var
znak : string;
w1, w2, przesuniecie : integer; // w1(wzorzec przed znakiem) w2(wzorzec po znaku)
t, w : boolean; // t(szukanie następnego wzorca), w(brak wystąpienia jakiegokolwiek wzorca)
begin
w := true;
w1 := szukajka(wzorzec1, tekst, 1);
while (w1 > 0) do
begin
t := false; // domyślnie nie będzie drugiego wzorca
if znak = '*' then
begin
przesuniecie := 0;
t := true;
end
else
if znak = '+' then
begin
przesuniecie := 1;
t := true;
end
else
begin
writeln(copy(tekst, w1, w2 + length(wzorzec2) - 1 - w1)); //tekst od w1 do w2+length(wzorzec2) wyświetl wyniki 2
w := false; // coś znaleziono
end;
if t then // mamy pierwszy wzorzec, trzeba szukać następnego
begin
t := true; // zakładamy, że nic nie znajdziemy
w2 := szukajka(wzorzec2, tekst, w1 + length(wzorzec1) + przesuniecie); // znalezienie pierwszego pasującego
while (w2 > 0) do // dopóki mamy pasujące wzorce po */+
begin
t := false; // zle zalozylimy. jednak cos znaleziono
writeln('(', copy(tekst, w1, w2 - w1 + length(wzorzec2)), ', ', w1, '),'); // wyświetlenie
w := false; // coś znaleziono
w2 := szukajka(wzorzec2, tekst, w2 + 1); // szukamy następnego pasującego wzorca
end; // itd, itd...
if t then
writeln('Brak wynikow'); // brak wyniku
end;
w1 := szukajka(wzorzec1, tekst, w1 + 1); // szukamy od następnej pozycji w tekście
end;
if w then
writeln('Brak wynikow'); // brak wyniku
end;
begin
clrscr;
pobierz_dane;
szukaj_wzorca(1, 1);
parametry;
szukajka(wzorzec, tekst, 1);
wyniki;
readln;
end.