Ich hatte mal nen Problem, zwei Strings zu vergleichen aber einen Prozentwert der Übereinstimmung zu bekommen, nichts leichter als das, dachte ich.
Hier nun das Ergebnis meiner Recherchen.
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70:
| function compareMyStrings(_S1, _S2: String): integer; var hit: Integer; p1, p2: Integer; l1, l2: Integer; pt: Integer; diff: Integer; hstr: string; test: array [1..255] of Boolean; S1,S2: String; begin S1:= UpperCase(trim(_S1)); S2:= UpperCase(trim(_S2)); if (length(S1)=0 )or(length(S2)=0) then result:=0 else begin if Length(s1) < Length(s2) then begin hstr:= s2; s2:= s1; s1:= hstr; end; l1:= Length (s1); l2:= Length (s2); p1:= 1; p2:= 1; hit:= 0; diff:= Max (l1, l2) div 3 + ABS (l1 - l2); for pt:= 1 to l1 do test[pt]:= False; repeat if not test[p1] then begin if (s1[p1] = s2[p2]) and (ABS(p1-p2) <= diff) then begin test[p1]:= True; Inc (hit); Inc (p1); Inc (p2); if p1 > l1 then p1:= 1; end else begin test[p1]:= False; Inc (p1); if p1 > l1 then begin while (p1 > 1) and not (test[p1]) do Dec (p1); Inc (p2) end; end; end else begin Inc (p1); if p1 > l1 then begin repeat Dec (p1); until (p1 = 1) or test[p1]; Inc (p2); end; end; until p2 > Length(s2); try Result:= 100 * hit DIV l1; except result:=100; end; end; end; |
grez
msch
Moderiert von Udontknow: Thema verschoben.