17.01.2012, 20:58
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)
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)
Kod:
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);
szukajka(wzorzec, tekst, 1);
parametry;
wyniki;
readln;
end.