Prüfen ob Wörter in einem String vorkommen, Reihenfolge egal

[Gambit]

Hallo,

ich möchte prüfen ob alle Wörter eines Strings in einem anderen String vorkommen. Dabei soll es egal sein in welcher Reihenfolge die Wörter stehen.
Beispiel:

String1: Otto Harfe spielt gern
String2: Otto spielt gern Harfe am Wochenende

Bei der Prüfung o.g. Beispiels soll eine Prüfung true zurückgeben.
Kann man das recursiv lösen? Hat jemand eine Idee?

Gruß

Gambit

[Snoop007]

die funktion pos durchsucht einen string nach einem gesuchent string
wurde der entsprechende zu suchende string gefunden, gibt die funktione einen wert grösser 0 zurück

[Sharky]

Hai Gambit,

entscheidend ist die Frage: Woher weisst Du wo ein Wort endet? Sind die Wörter immer durch ein blank getrennt?
Wenn Ja: Verwende einfach eine TStringList und schaue Dir mal die Eigenschaften DelimitedText und Delimiter an.
Damit und einer einfachen Schleife und der Funktion Pos sollte das ganze leicht zu lösen sein.

[lume96]

Im Deinem Fall würde ich bei der POS-funktion vorsichtig vorgehen, die findet nämlich auch Substrings.

Z.B.:
String1 = 'Die Woche'
string2 = 'Die Sonne wird dieses Wochenende nur selten zu sehen sein'

Wenn Du hier mit Pos() Wort für Wort vergleicht (gegeben, Du hast die Strings in die verschiedenen Worte zerlegt), wird Dir Pos() sagen, alles ok, denn Pos('Woche','Wochenende') ist 1, also gefunden. Ich würde jedes Wort, vor dem Vergleich, noch zusätzlich am Anfang und am Ende mit einem 'Delimiter' versehen, der sonst eher nicht vorkommt z.B. #9 (Tabulation) wort1 := #9+wort1+#9.

Vorsicht auch bei Gross- und Kleinschreibung : Woche <> woche
Unter Umständen 'n Uppercase() oder lowercase() um jedes Wort, wenn bei Dir 'Woche' = 'woche' sein soll.

MfG
Lutz

[Gambit]

Habe folgendes im Swiss-Center gefunden, irgendwie funzt es aber nicht, wenn ich nur ein Wort im Edit-Feld eingebe gehts, gebe ich mehr als eins ein, zeigt die StringList gar nicht mehr. Vielleicht hat ja mal einer Lust, das auszuprobieren. Die Methode, die den Text aus dem Memo in Wörter zerlegt funzt auf jeden Fall scheinbar prima(habs noch nicht mit Umlauten probiert..)

Delphi-Quellcode:

procedure SplitTextIntoWords(const S: string; words: TstringList);
var
  startpos, endpos: Integer;
begin
  Assert(Assigned(words));
  words.Clear;
  startpos := 1;
  while startpos <= Length(S) do
  begin
    // skip non-letters
    while (startpos <= Length(S)) and not IsCharAlpha(S[startpos]) do
      Inc(startpos);
    if startpos <= Length(S) then
    begin
      // find next non-letter
      endpos := startpos + 1;
      while (endpos <= Length(S)) and IsCharAlpha(S[endpos]) do
        Inc(endpos);
      words.Add(Copy(S, startpos, endpos - startpos));
      startpos := endpos + 1; 
    end; { If }
  end; { While } 
end; { SplitTextIntoWords } 

function StringMatchesMask(S, mask: string; 
  case_sensitive: Boolean): Boolean; 
var 
  sIndex, maskIndex: Integer;
begin 
  if not case_sensitive then 
  begin 
    S    := AnsiUpperCase(S);
    mask := AnsiUpperCase(mask); 
  end; { If } 
  Result    := True; // blatant optimism 
  sIndex    := 1;
  maskIndex := 1; 
  while (sIndex <= Length(S)) and (maskIndex <= Length(mask)) do 
  begin 
    case mask[maskIndex] of
      '?': 
        begin 
          // matches any character 
          Inc(sIndex);
          Inc(maskIndex); 
        end; { case '?' } 
      '*': 
        begin
          // matches 0 or more characters, so need to check for 
          // next character in mask 
          Inc(maskIndex); 
          if maskIndex > Length(mask) then
            // * at end matches rest of string 
            Exit 
          else if mask[maskindex] in ['*', '?'] then 
            raise Exception.Create('Invalid mask');
          // look for mask character in S 
          while (sIndex <= Length(S)) and 
            (S[sIndex] <> mask[maskIndex]) do 
            Inc(sIndex);
          if sIndex > Length(S) then 
          begin 
            // character not found, no match 
            Result := False;
            Exit; 
          end; 
          { If } 
        end; { Case '*' }
      else if S[sIndex] = mask[maskIndex] then 
        begin 
          Inc(sIndex); 
          Inc(maskIndex);
        end { If } 
        else 
          begin 
            // no match
            Result := False; 
            Exit; 
          end; 
    end; { Case } 
  end; { While }
  // if we have reached the end of both S and mask we have a complete 
  // match, otherwise we only have a partial match 
  if (sIndex <= Length(S)) or (maskIndex <= Length(mask)) then 
    Result := False; 
end; { stringMatchesMask }

procedure FindMatchingWords(const S, mask: string; 
  case_sensitive: Boolean; matches: Tstrings); 
var
  words: TstringList;
  i: Integer; 
begin 
  Assert(Assigned(matches));
  words := TstringList.Create;
  try
    SplitTextIntoWords(S, words); 
    matches.Clear; 
    for i := 0 to words.Count - 1 do 
    begin 
      if stringMatchesMask(words[i], mask, case_sensitive) then
        matches.Add(words[i]);
    end; { For } 
  finally
    words.Free;
  end;
end; 

{ 
 The Form has one TMemo for the text to check, one TEdit for the mask, 
 one TCheckbox (check = case sensitive), one TListbox for the results,
 one Tbutton 
}

procedure TForm1.Button1Click(Sender: TObject);
begin
  FindMatchingWords(memo1.Text, edit1.Text, checkbox1.Checked, listbox1.Items);
end;

Gruß

Gambit

[Snoop007]

ich hätte das eher so gemacht
string1 = "Das Gross - Fest"
string2 = "das Grosse Festival hat begonnen"

Code:

wiederhole das ganze solange bis startpos_1 = die länge von string1 hat
  du guckst, ist die position vom leerzeichen grösser als die länge des strings
  wenn ja
    merken wert in startpos_1 // ertsmal die länge des zu suchenden strings bestimmen
  
  du kopiertst vom anfang aus string1 bis startpos_1 den string ( funktion copy ) in rem_s
  merke länge von rem_s in rem_l
  // jetzt haben wird den sting, den wir suchen möchten

  merke das ergebnis von pos wenn rem_s und string2 eingegebenwurde in str_2_pos

  ist tr_2_pos > 0
  wenn ja
    // ein string der dem zu suchenden string ähnelt wurde gefunden
    kopiere von der postition tr_2_pos aus strnig2 bis zu einem leerzeichen oder bis zum ende
    merke diesen wert in rem_s2
    ist rem_s2 = rem1 // prüfen ob er auch gleich ist
    wenn ja
      ist der zu suende string gefunden

ich hoffe ich habe keinen denkfehler geamcht

[Sharky]

Hai Gambit,

mit den Schlüsselwörtern von mir hätte es eigentlich gehen sollen
Hier mal mein Versuch:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  str1 : String;
  str2 : String;
  sl   : TStringList;
  ndx  : Integer;
  okay : Boolean;
begin
  str1 := 'Otto Harfe spielt gern';
  str2 := 'Otto spielt gern Harfe am Wochenende';
  okay := False;
  sl := TStringList.Create;
  try
    sl.Delimiter := ' ';
    sl.DelimitedText := str1;
    for ndx := 0 to pred (sl.Count) do
    begin
      okay := Pos (sl.Strings[ndx],str2) > 0;  // Wort ist vorhanden
      if not (okay) then
      begin
        break;
      end;
    end;
  finally
    FreeAndNil (sl);
  end;
  if (okay) then
  begin
    ShowMessage ('Alle Wörter gefunden');
  end
  else
  begin
    ShowMessage ('Nicht alle Wörter gefunden');
  end;
end;

[lume96]

Zitat von Gambit:

Habe folgendes im Swiss-Center gefunden, irgendwie funzt es aber nicht, wenn ich nur ein Wort im Edit-Feld eingebe gehts, gebe ich mehr als eins ein, zeigt die StringList gar nicht mehr.

Delphi-Quellcode:

procedure SplitTextIntoWords(const S: string; words: TstringList);
var
  startpos, endpos: Integer;
begin

...

procedure TForm1.Button1Click(Sender: TObject);
begin
  FindMatchingWords(memo1.Text, edit1.Text, checkbox1.Checked, listbox1.Items);
end;

Gruß

Gambit

Hab den Code zwar nur kurz überflogen, aber so wie ich's verstanden habe macht der folgendes :

Bei
FindMatchingWords(string1, string2, checkbox1.Checked, listbox1.Items); durchsucht er die STRING1 nach Übereinstimmungen mit der STRING2 die eine Suchmaske enthält und gibt das Resultat in die Listbox1 aus.

Z.B.:

   FindMatchingWords('OTTO spielt LOTTO', '?TT?', false, listbox1.Items); sollte Dir nur OTTO ausgeben, während
   FindMatchingWords('OTTO spielt LOTTO', '*TT?', false, listbox1.Items); Dir OTTO und LOTTO augeben sollte.

Hier wird eine Sting mit meheren Wörtern (String1) nach einer Übereinstimmung mit einer Suchmaske überprüft.
Also nicht das, was Du suchst.

Allerdings findest Du 'ne Menge interessanter Funktion die Dir helfen könnten, wie z.B. SlitTextIntoWords.

MfG.
LUtz

[Gambit]

Jepp, Danke!!

Ja, es geht, hat aber tatsächlich den von Lutz angesprochenen Nachteil, das z.B Woche auch in Wochenende gefunden wird...

In dem Swiss Beispiel passiert das nicht, dafür habe ich noch nicht rausgefunden, warum es nicht alle Wörter in der StringList aufführt werden...

Gruß

Gambit

[Gambit]

Oh überschneidung...danke Lutz!
Die Methode SplittTextintoWords sollte man aber tatsächlich gebrauchen können...

Gam