Wyszukiwanie wzorca z parametrem...

witam, niestety nie wiem jak zrobić część programu...zrobiłem już wyszukiwanie "zwykłego wzroca"(bez parametrów), a także takich z znakami zapytania. Nie mam pojęcia jak zrobić natomiast wyszukiwanie z znakiem + lub znakiem * (znak * i + nie mogą razem występować w wzorcu, natomiast znak ? moze ile razy chce). Tutaj polecenie zadania:

Program 5 – Wyszukiwanie wzorca
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)

Narazie mój program wygląda tak...może ktoś wie co zrobić by działała reszta...Narazie mam do + i * tylko znajdowanie na jakim miejscu są...




```delphi
program Wzorzec_program;

uses crt;

var tekst, wzorzec : string;
    tekstdl, wzorzecdl, MAX, k, i, plus, razy: integer;
    indeks: array[0..255] of integer;

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
  begin
   writeln('BLAD. Wzorzec dluzszy od tekstu.');
   writeln;
   pobierz_dane;
  end;

 if (length(tekst)=0) or (length(wzorzec)=0)  then
  begin
   writeln('BLAD. Niepoprawne dane.');
   writeln;
   pobierz_dane;
  end;

  if wzorzec='?' then
   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);
      if MAX < wzorzecdl then
       begin
        writeln('BLAD. Podana dlugosc musi byc wieksza lub rowna dlugosci wzorca');
        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);
begin
  repeat
   if (tekst[i]=wzorzec[j]) or (wzorzec[j]='?') then
    begin
     inc(i);
     inc(j);
    end
   else
    begin
     i:= i-j+2;
     j:=1;
    end;
  until (i>tekstdl) or (j>wzorzecdl);

   if j>wzorzecdl then
    begin
     indeks[k]:=i-wzorzecdl;
     inc(k);
     szukaj_wzorca(i-wzorzecdl+1, 1);
    end;
end;


procedure wyniki;
var i, j:integer;
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;

begin
 clrscr;
 pobierz_dane;
 szukaj_wzorca(1, 1);
 wyniki;
 readln;
end.

Może zna ktoś jakiś fajny algorytm to wyszukiwania tego wzorca z parametrem...To jest coś jak wyszukiwarka internetowa tylko w pascalu...heh Proszę o POMOC

Do wyszukiwarki internetowej to mu bardzo daleko ;)

dla *:
Po znalezieniu gwiazdki przesuwasz się o 1 we wzorcu i szukasz dalszych jego znaków w tekście (zapamiętując pozycję pierwszego znalezionego, oraz pozycji wzorca za *), niepasujące ignorujesz. Jak znajdziesz pasujący wzorzec, lub nie uda Ci się dopasować następnych znaków, wracasz do zapamiętanej pozycji wzorca, a w tekście przechodzisz o 1 dalej niż pozycja jaką zapamiętałeś poprzednio (i zapamiętujesz nową pozycję szukania po znalezieniu pierwszego pasującego). I tak aż nie skończy Ci się maksymalna długość znalezionego tekstu.

dla +:
to co powyżej, tyle że po znalezieniu + przesuwasz się we wzorcu i w szukanym tekście o 1.

Jeśli chcesz zrobić to względnie wydajnie (nie mówię że będzie to prostsze, choć raczej krótsze implementacyjnie) zainteresuj się automatami stanów. Przy ich zastosowaniu nie będzie problemów z występowaniem wielu ? przed i po */+.

heh, dalej nie potrafie tego zrobić...jeszcze dochodzi do tego sprawa tego znaku zapytania, heh

mógłbyś mnie wesprzeć jakimś fragmentem kodu?

Powiedzmy tak, masz działający kod wyszukiwania wzorca z dowolną ilością ?. Pisałeś że masz, więc wyjdźmy od niego.

Zrób funkcję zwracającą pozycję wystąpienia takiego wzorca (0 lub mniej jak nie znajdzie), a jako parametry niech przyjmuje wzorzec, tekst, oraz pozycję od jakiej ma szukać tego wzorca, powiedzmy niech się to nazywa

function simple(const w,t:string; p:integer):integer;

Jedyne co zostanie Ci wtedy do zrobienia to sprawdzenie poprawności wzorca (jedno lub wcale wystąpień */+), oraz ewentualne rozbicie go po tym problematycznym znaku (tutaj na wzorzec1, wzorzec2). A samo znalezienie całości będzie wyglądało tak:

w1 := simple(wzorzec1,tekst,1);
if w1 > 0 then
  if znak = '*' then
    begin
      w2 := simple(wzorzec2,tekst,w1+length(wzorzec1));
      if w2 > 0 then
// wyświetl wyniki 1
      else
// brak wyników
    end
  else if znak = '+' then
    begin
      w2 := simple(wzorzec2,tekst,w1+length(wzorzec1)+1);
      if w2 > 0 then
// wyświetl wyniki 1
      else
// brak wyników
    end
  else
// wyświetl wyniki 2
else
// brak wyniku

wynik 1 to tekst od w1 do w2+length(wzorzec2) a wynik 2 to tekst od w1 do w1+length(wzorzec1)

A jak chcesz wyszukać wszystkie wzorce to możesz zrobić jeszcze wewnątrz szukanie w pętli dla w2 co obieg zwiększanego o 1, oraz na zewnątrz dla w1 zwiększanego co przebieg pętli o 1.

Edytka:

Ale najpierw może zrób działającą wersję dla szukania pojedynczego wystąpienia. I jak się da to unikaj rekurencji, bo to niepotrzebne obciążanie pamięci, a tu może się trochę wywołań tych funkcji znaleźć.
I nie używaj zmiennych globalnych. To co trzeba funkcji z zewnątrz przekazuj przez parametry, kod jest czytelniejszy i nie trzeba się zastanawiać co skąd używamy.

Wielkie dzięki za pomoc. Chyba już rozumiem jak to zrobić...Dzisiaj już do tego nie mam głowy, jutro od rana będę siedział i robił ten program...na poniedziałem go muszę mieć, to jak coś to będę się jeszcze pytał.

Aha, jeszcze jedno według tego mam po prostu sobie rozbić wzorzec na wzorce, np:

mam wzorzec: al+rf, to z tego wychodzi ze wzorzec1=al, wzorzec2=rf ?

Dokładnie. A od "spójnika" tylko będzie zależało czy następny wzorzec będziesz szukał z przesunięciem o ten jeden znak.

heh, nie wiem czemu, ale gdzies musi byc błąd, np. dla

tekst: alamak
wzorzec:la*ma
daje odpowiedz: lamak, a powinno być lama. Taka samo błędy są jak jest * na początku, albo na końcu, chyba do tego jak jest znak na początku czy na końcu będę musiał zrobić całkowicie nową funkcje...

tutaj fragment kodu:

function szukajka(var w,t:string; p:integer):integer;
var j:integer;
begin
j:=1;
 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;

procedure parametry;
var w1, w2:integer;
begin
 w1 := szukajka(wzorzec1,tekst,1);
 if w1 > 0 then
  if znak = '*' then
    begin
      w2 := szukajka(wzorzec2,tekst,w1+length(wzorzec1));
      if w2 > 0 then
       writeln(copy(tekst, w1, w2+length(wzorzec2)-1))             //tekst od w1 do w2+length(wzorzec2)   wyświetl wyniki 1
      else
       writeln('Brak wynikow');   // brak wyników
    end
  else if znak = '+' then
    begin
      w2 := szukajka(wzorzec2,tekst,w1+length(wzorzec1)+1);
      if w2 > 0 then
       writeln(copy(tekst, w1, w2+length(wzorzec2)-1))              //tekst od w1 do w2+length(wzorzec2) wyświetl wyniki 1
      else
       writeln('Brak wynikow');  // brak wyników
    end
  else
   writeln(copy(tekst, w1, w1+length(wzorzec1)))             //tekst od w1 do w1+length(wzorzec1) wyświetl wyniki 2
 else
  writeln('Brak wynikow');  // brak wyniku
end;

W copy nie podajesz pozycji znaku początkowego i końcowego do skopiowania, tylko pozycję początkowego i ilość znaków do skopiowania, więc powinno być

writeln(copy(tekst, w1, w2+length(wzorzec2)-1-w1))

Jeśli chodzi o */+ na początku/końcu zobacz czy w szukajka nie wystarczy zwrócić dla pustego wzorca pozycję od jakiej ma zacząć szukać, IMO powinno wystarczyć.

Edytka:
sorki, to wystarczy dla */+ na początku. Na końcu trzeba by zwrócić resztę tekstu, ale to już możesz w parametry zrobić sprawdzając czy wzorzec2 nie jest pusty.

W copy nie podajesz pozycji znaku początkowego i końcowego do skopiowania, tylko pozycję początkowego i ilość znaków do skopiowania

hehe, a myślałem ze na odwrót...to wszystko zmienia hehe, zaraz sprawdzam czy działa...

ok, już mi poprawnie wyszukuje pierwsze wystąpienie danego wzorca, teraz tak jak mówiłeś pętle...tylko gdzie i jak je powsadzać, mógłbyś mi pomóc ? widzę że tylko ty interesujesz się moim tematem. Program muszę jutro oddać, myślałem że go sam napiszę do końca ale pojawiły się problemy i dlatego na tym forum wylądowałem...

tutaj działający kod:

function szukajka(var w,t:string; p:integer):integer;
var j:integer;
begin
j:=1;

if w='' then
 szukajka:=1
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 w1, w2:integer;
begin
 w1 := szukajka(wzorzec1,tekst,1);
 if w1 > 0 then
  if znak = '*' then
    begin
      w2 := szukajka(wzorzec2,tekst,w1+length(wzorzec1));
      if w2 > 0 then
       if wzorzec2='' then
        writeln('(', copy(tekst, w1, length(tekst)), ', ' , w1, '), ')
       else
        writeln('(', copy(tekst, w1, w2+length(wzorzec2)-w1), ', ' , w1, '), ')             //tekst od w1 do w2+length(wzorzec2)   wyświetl wyniki 1
      else
       writeln('Brak wynikow');   // brak wyników
    end
  else if znak = '+' then
    begin
      w2 := szukajka(wzorzec2,tekst,w1+length(wzorzec1)+1);
      if w2 > 0 then
       if (wzorzec2='') and (w1+length(wzorzec1)-1<>length(tekst)) then
        writeln('(', copy(tekst, w1, length(tekst)), ', ' , w1, '), ')
       else if (w1+length(wzorzec1)-1=length(tekst)) then
        writeln('Brak wynikow')
       else
        writeln('(', copy(tekst, w1, w2+length(wzorzec2)-w1), ', ' , w1, '), ')            //tekst od w1 do w2+length(wzorzec2) wyświetl wyniki 1
      else
       writeln('Brak wynikow');  // brak wyników
    end
  else
   writeln(copy(tekst, w1, w1+length(wzorzec1)))             //tekst od w1 do w1+length(wzorzec1) wyświetl wyniki 2
 else
  writeln('Brak wynikow');  // brak wyniku
end;

Bardzo prosiłbym o pomoc z tymi pętlami...

EDIT

ok, mam coś takiego

function szukajka(var w,t:string; p:integer):integer;
var j:integer;
begin
j:=1;

if w='' then
 szukajka:=1
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 w1, w2, i, j, k, c:integer;
begin
for i:=1 to tekstdl do
begin
 w1 := szukajka(wzorzec1,tekst,i);
 if w1 > 0 then
  if znak = '*' then
    begin
    for j:=0 to tekstdl do
    begin
      w2 := szukajka(wzorzec2,tekst,w1+length(wzorzec1)+j);
      if w2 > 0 then
       if wzorzec2='' then
        for k:=0 to (tekstdl-(w1+length(wzorzec1)-1)) do
         writeln('(', copy(tekst, w1, length(wzorzec1)+k), ', ' , w1, '), ')
       else
        writeln('(', copy(tekst, w1, w2+length(wzorzec2)-w1), ', ' , w1, '), ')             //tekst od w1 do w2+length(wzorzec2)   wyświetl wyniki 1
      else
       writeln('Brak wynikow');   // brak wyników
    end;
    end
  else if znak = '+' then
    begin
    for j:=0 to tekstdl do
    begin
      w2 := szukajka(wzorzec2,tekst,w1+length(wzorzec1)+1+j);
      if w2 > 0 then
       if (wzorzec2='') and (w1+length(wzorzec1)-1<>length(tekst)) then
        writeln('(', copy(tekst, w1, length(tekst)), ', ' , w1, '), ')
       else if (w1+length(wzorzec1)-1=length(tekst)) then
        writeln('Brak wynikow')
       else
        writeln('(', copy(tekst, w1, w2+length(wzorzec2)-w1), ', ' , w1, '), ')            //tekst od w1 do w2+length(wzorzec2) wyświetl wyniki 1
      else
       writeln('Brak wynikow');  // brak wyników
    end;
    end
  else
   writeln(copy(tekst, w1, w1+length(wzorzec1)))             //tekst od w1 do w1+length(wzorzec1) wyświetl wyniki 2
 else
  writeln('Brak wynikow');  // brak wyniku
end;
end;

tylko mi duzo za duzo wyrzuca wyników, te warunki pętel muszą być inne ale nie wiem jakie... :/

do tego jeszcze brakuje mi wyników dla */+ jak są na początku teraz mam tak:

tekst:alamakota
wzorzec: *ma
wynik: alama

a powinny być wyniki: ma, ama, lama, alama,

Masz błąd, nie

if w='' then
 szukajka:=1

tylko

if w='' then
 szukajka:=p

I teraz trzeba dodać 2 pętle, jedna jeżdżąca po drugim wzorcu, i jedna po pierwszym. Dla uproszczenia trochę zmodyfikuję twój kod:

procedure parametry;
var 
  w1, w2, przesuniecie:integer;
  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, w1+length(wzorzec1)))             //tekst od w1 do w1+length(wzorzec1) wyświetl wyniki 2
          w := false; // coś znaleziono
        end;
      if t then  // a tu jak mamy pierwszy wzorzec oraz 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; // a jednak coś jest
              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;  // i tak w koło macieju
          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;

Powinno działać, modyfikowałem z palca, bo nie mam pod ręką kompilatora.

niestety nie działa dla +/* występujących na początku i końcu, mam nadzieje ze uda mi sie to zmodyfikować. Wielkie dzięki ze mi pomagasz :]

EDIT:

WIELKIE DZIĘKI za całą pomoc. Skończyłem w końcu ten program :D