SRL Archive - SRL Suggestions

Hello, I think that this function was requested by mastaraymond.
This will compare 2 strings and Result accuracy as a percent.

We could use this as an addition to IsUpText function what we currently have.

function StringMatch(Text, rs_UpText: string): Extended;
var
  i, High: Integer;
  ii: Extended;
begin
  High := Length(Text);
  SetLength(rs_UpText, High);
  ii := -1;
  for i := 1 to High do
    if (Pos(LowerCase(Text[i]), LowerCase(rs_UpText[i])) <> 0) then
      ii := ii + (100.0 / High);
  if ii > 0 then
    Result := ii + 1.0
  else
    Result := 0.0;
end;

begin
  Writeln(ToStr(StringMatch('Walk here', 'Walk her3eeeeeee')));
end. 

As you can see it will LowerCase whole word and it will make both words same length (by "Text Variable) I have tested it and it works.


~Home

Related: http://bugs.villavu.com/view.php?id=345

The wiki link posted there may be useful too.

So it would be implemented like this?

function IsUpText(UpText: string): Boolean;
begin
  Result := (StringMatch(UpText, GetUpText) > 80.0);
end;

function IsUpTextMultiCustom(Text: TStringArray): Boolean;
var
  TheText: string;
  i, n: Integer;
begin
  TheText := GetUpText;
  n := High(Text);
  for i := 0 to n do
    if (StringMatch(Text[i], GetUpText) > 80.0) then
    begin
      Result := True;
      Exit;
    end;
end;

I'm not sure what a good value for the percentage would be.

http://www.merriampark.com/ldc.htm

Just for my reference, I will do this later.

Nice. I really like the concept of resulting things in percentages for conditionals when possible. I was using the same concept on a chatbox tool a while back, and many solvers use it too.

unit Levenshtein;
//Objeto que calcula la distancia de Levenshtein entre 2 cadenas.
//Alvaro Jeria Madariaga. 04/10/2002
//barbaro@hotpop.com
interface
uses sysutils, Math;
type
  Tdistance = class(TObject)
  private
    function minimum(a, b, c: Integer): Integer;
  public
    function LD(s, t: string): Integer;
  end;

implementation

function Tdistance.minimum(a, b, c: Integer): Integer;
var mi: Integer;
begin
  mi := a;
  if (b < mi) then
    mi := b;
  if (c < mi) then
    mi := c;
  Result := mi;
end;

function Tdistance.LD(s, t: string): Integer;
var
  d: array of array of Integer;
  n, m, i, j, costo: Integer;
  s_i, t_j: char;
begin
  n := Length(s);
  m := Length(t);
  if (n = 0) then begin
      Result := m;
      Exit;
    end;
  if m = 0 then begin
      Result := n;
      Exit;
    end;
  setlength(d, n + 1, m + 1);
  for i := 0 to n do
    d[i, 0] := i;
  for j := 0 to m do
    d[0, j] := j;
  for i := 1 to n do
    begin
      s_i := s[i];
      for j := 1 to m do
        begin
          t_j := t[j];
          if s_i = t_j then costo := 0 else costo := 1;
          d[i, j] := Minimum(d[i - 1][j] + 1, d[i][j - 1] + 1, d[i -1][j - 1] + costo);
        end;
    end;
  Result := d[n, m];
end;

Source: http://www.merriampark.com/lddelphi.htm

Double posting..

This is what I implemented from the latter algorithm.

program StringTest;

function MinA(a: TIntegerArray): Integer;
var
  L, i: Integer;
begin
  L := High(a);
  if (L < 0) then
  begin
    Result := 0;
    Exit;
  end;

  Result := a[0];

  for i := 1 to L do
    if (a[i] < Result) then
      Result := a[i];
end;

(*
LevDistance
===========

Number of deletions, insertions, or substitutions to transform src into target.
*)
function LevDistance(src, target: string): Integer;
var
  d: T2DIntegerArray;
  n, m, i, j, cost: Integer;
  s_i, t_j: char;
begin
  n := Length(src);
  m := Length(target);
  if (n = 0) then
  begin
    Result := m;
    Exit;
  end;
  if (m = 0) then
  begin
    Result := n;
    Exit;
  end;

  setLength(d, n + 1);
  for i := 0 to n do
    setLength(d[i], m + 1);
  // setLength(d, n+1, m+1);

  for i := 0 to n do
    //d[i, 0] := i;
    d[i][0] := i;
  for j := 0 to m do
    //d[0, j] := j;
    d[0][j] := j;

  for i := 1 to n do
  begin
    s_i := src[i];
    for j := 1 to m do
    begin
      t_j := target[j];
      cost := Integer(not (s_i = t_j));
      //d[i, j] := Minimum(d[i - 1][j] + 1, d[i][j - 1] + 1, d[i -1][j - 1] + cost);
      d[i][j] := MinA([d[i-1][j] + 1, d[i][j-1] + 1, d[i-1][j-1] + cost]);
    end;
  end;

  Result := d[n][m]
  //Result := d[n, m];

  WriteLn(Format('"%s" & "%s" -> %d', [src, target, Result]));
end;

function NormLevDistance(src, target: String): Extended;
begin
  Result := Max(Length(src), Length(target)) * 1.0;
  Result := LevDistance(src, target) / Result;
  WriteLn(Format('NORM: "%s" & "%s" -> %f', [src, target, Result]));
end;

begin
  NormLevDistance('Talk-to Banker / 4 more options', '$alk-to  Bakor / 4 more opt;ons');
  NormLevDistance('Open Banker Kids (level: 51) / 3 more options', 'Open');
  NormLevDistance('xxUxxxx', 'GUMBO');
  NormLevDistance('Mine Ro$ks', 'Mine Rocks');
  NormLevDistance('^t0a 8ooU; v Z 0o(a oo0to0;', 'Mine Rocks / 3 more options');
end.   

It's not looking that promising..

Why don't we just use TRegExpr unit included in fpc…?

From: mormonman
Why don't we just use TRegExpr unit included in fpc…?

Because this is a more general function. You could actually give most of the uptext as argument and it'll return how similar it is to the OCR'd uptext.

Say, UpText OCR = 'Talk t anker' (not that this happen but regardless), and you just put 'Talk To Banker', then it should match with a certain similary. If you're using regexes, you can only tell it to disregard certain characters like so: 'Talk t.+anker', and that would only work where a o and B (or one) are missing. This should be much more powerful.

Plus, Simba already has Regex functions. :)

We have to figure out a reasonable way of partitioning strings to put through the Lev. Distance function.

Currently, you can not put partial matches and hope it works.

For example, we have the '/ 4 or more options' at the end of all UpText, how often do we really take that into account? We just have to filter the text prior, and it makes sense.

From: Nava2
We have to figure out a reasonable way of partitioning strings to put through the Lev. Distance function.

Currently, you can not put partial matches and hope it works.

For example, we have the '/ 4 or more options' at the end of all UpText, how often do we really take that into account? We just have to filter the text prior, and it makes sense.

Append the text to the search text, or give give the ocr-ed text the same length as the to search text (or if it detects a / even delete everything after that)

I think adding the '/ 4 more options' would not be reasonable solution as it will drastically decrease the usability of the function - you only care about what is in front of it.

I feel like we should apply a regex to the uptext to filter out that /.. but some might still want it. Uhm, this is interesting..

:/

https://github.com/MerlijnWajer/Simba/pull/46

I also wrote this up:

program StringTest;

function FilterUpText(src: String): String;
var
  splitRegex: String;
begin
  splitRegex := '\s/\s[0-9]{1,}\smore\soptions.*$';

  Result := ReplaceRegExpr(splitRegex, src, '', True);
  WriteLn(Format('Input: "%s" Filtered: "%s"', [src, Result]));
end;

begin

  FilterUpText('Talk-to Banker / 500 more options   ');
  FilterUpText('Talk-to Banker / 5 more options ');
  FilterUpText('Trade-with Goldy59 / 9 more options');
end. 

One can use it as a back-up for FindUptextMulti?

Or… crazy thought here, but why don't we not over-complicate things and just use Homes function in the OP. :rolleyes:

From: Coh3n
Or… crazy thought here, but why don't we not over-complicate things and just use Homes function in the OP. :rolleyes:

Because this: Writeln(ToStr(StringMatch('Walk here', '*Walk here'))); will return 0 accuracy? There's obvious problems with the OP procedure that can be avoided using a more sophisticated function

Lol, well I just assumed that procedure worked. My mistake then.

Possibly interesting: http://ntz-develop.blogspot.com/2011/03/fuzzy-string-search.html

From: Wizzup?
Possibly interesting: http://ntz-develop.blogspot.com/2011/03/fuzzy-string-search.html

Damerau-Levenshtein distance
http://code.google.com/p/fuzzy-search-tools/source/browse/trunk/src/ru/fuzzysearch/DamerauLevensteinMetric.java
It's also GPL'd thus we can use the algorithms, obviously converted.

Looks most applicable, great read, though.

Darau-Levenshtein distance is cool because it tells you the least amount of edits you could do to transform one into the other, but the Jaro-Winkler score is much for useful for comparison.

For one, the algorithm actually returns a normalized score between 0 and 1 for rating the similarity of the strings.

I've implemented both in Simba and wrote a StringMatch function as well. Filtering of the "\ 4 more options" should, I believe, fall outside of StringMatch.

Attached is the script.

From: legoace
Darau-Levenshtein distance is cool because it tells you the least amount of edits you could do to transform one into the other, but the Jaro-Winkler score is much for useful for comparison.

For one, the algorithm actually returns a normalized score between 0 and 1 for rating the similarity of the strings.

I've implemented both in Simba and wrote a StringMatch function as well. Filtering of the "\ 4 more options" should, I believe, fall outside of StringMatch.

Attached is the script.

Very nice, seems to work pretty well from what I tested.

Using legoace's Jaro-Winkler I made this up. I think it would work best for us.

function JaroWinkler(u, v: String): Double;
var
  a, b, i, j, m, t, mr, l: Integer;
  ut, vt: String;
  uignore, vignore: Array of Integer;
begin
  result := 0.;

  a := length(u);
  b := length(v);
  mr := ceil(max(a, b) / 2.) - 1;
  setLength(uignore, a);
  setLength(vignore, b);

  // Calculate "M" (matches)
  m := 0;
  for i := 1 to a do
  begin
    for j := 1 to b do
    begin
      if((u[i] = v[j]) and (uignore[i-1] = 0) and (vignore[j-1] = 0))then
        if(abs(i - j) <= mr)then
        begin
          Inc(m);
          uignore[i-1] := 1;
          vignore[j-1] := 1;
          break;
        end;
    end;
  end;

  // Calculate "T" (transpositions)
  t := 0;
  for i := 0 to a-1 do
    if(uignore[i] = 1)then ut := ut + u[i+1];
  for i := 0 to b-1 do
    if(vignore[i] = 1)then vt := vt + v[i+1];

  for i := 1 to length(ut) do
    if(not(ut[i] = vt[i]))then Inc(t);
  t := t / 2;

  // Winkler weighting (this could be removed)
  l := 0;
  for i := 1 to a do
    if(u[i] = v[i])then Inc(l) else break;

  // Answer
  try
    result := (1./3)*(  Extended(m)/a  +  Extended(m)/b  +  Extended(m-t)/m  );
    result := result + (l * 0.1 * (1.0 - result));
  except
  end;
end;

Function StringMatch(FindStr, UpTxt: string; tol: Extended): boolean;
var
  fL, uL, i: integer;
  S: String;
  Hi, J: Extended;
begin
  fL := Length(FindStr);
  uL := Length(UpTxt)+1;
  for i := 1 to uL-fL do
  begin
    J := JaroWinkler(FindStr, Copy(UpTxt, i, fL));
    if J > Hi then
      Hi := J;
  end;
  Result := Hi >= tol;
end;

Function WaitMatchUpTextMulti(StrArr: TStringArray; Wait: Integer; tol: Extended): Boolean;
var
  i, t: Integer;
  S: string;
begin
  t := GetSystemTime + Wait;
  repeat
    S := rs_GetUpText;
    for i := 0 to High(StrArr) do
    if StringMatch(StrArr[i], S, tol) then
    begin
      Result := True;
      Exit;
    end;
    sleep(1);
  until GetSystemTime > t;
end;  

begin
  ClearDebug;

  writeln(StringMatch('guard', 'Attack Guard (level 21)', 0.6));

end.

E:
Added UpText