Форум: "Основная";
Текущий архив: 2002.01.28;
Скачать: [xml.tar.bz2];

Вниз

Как найти далее при помощи pos?   Найти похожие ветки 

← →
Romkin   (2002-01-08 17:18) [19]

Попробовал, вот что получилось - функция не оптимальна, но вроде работает, эвристика по стоп-символу и суффиксу, дает значительный выигрыш на больших кусках текста и при длинных образцах (при коротких тоже неплохо)
Прибраться только надо, чтобы побыстрее работала... но влом

function fStrPos(const Line, Sample: string; FromPos, ToPos: integer): integer;
var
stLen, samLen: integer;
StopIndex: integer;
StopChar, ch: char;
SuffixStr, RevertSample: string;
SuffixLen: integer;
i, incr: integer;
begin
Result := 0;
//checks
SamLen := length(Sample);
if SamLen = 0 then exit;
if FromPos <= 0 then FromPos := 1;
stLen := length(Line);
if (ToPos < stLen) and (toPos >= FromPos) then
stLen := toPos;
//Переворачиваем Sample - удобно для Pos
SetLength(RevertSample, SamLen);
for i := 1 to SamLen do
RevertSample[SamLen - i + 1] := Sample[i];
//Пока не дошли до конца участка минус длина образца...
while FromPos <= (stLen - samLen + 1) do
begin
//сравниваем образец СПРАВА НАЛЕВО
StopIndex := 0;
for i := samLen downTo 1 do
if Sample[i] <> Line[i + FromPos - 1] then
begin
//На чем запнулись
StopIndex := i;
StopChar := Line[i + FromPos - 1];
SuffixStr := copy(Sample, i+1, samLen - i);
SuffixLen := length(SuffixStr);
Break;
end;
//Проверка совпадения
if StopIndex = 0 then
begin
Result := FromPos;
Exit;
end;
//Переворачиваем суффикс
for i := 1 to (SuffixLen div 2) do
begin
ch := suffixstr[SuffixLen - i + 1];
suffixstr[SuffixLen - i + 1] := suffixStr[i];
suffixstr[i] := ch;
end;
//Приращение по суффиксу - следующее вхождение
incr := Pos(SuffixStr, copy(RevertSample,SuffixLen + 1,SamLen));
//Приращение по стоп-символу:
for i := StopIndex - 1 downTo 1 do
if Sample[i] = StopChar then
begin
if incr < (SamLen - i) then
incr := SamLen - i;
break;
end;
if incr = 0 then incr := samLen;
inc(FromPos, incr);
end;
end;


---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.01.28;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.004 c