Поиск данных , в массивах, строках и других типах данных

[Romtek]

Бинарный поиск в упорядоченном массиве

Функция осуществляет поиск вхождения числа Key в массив A в указанных границах Lb..Ub, в результате функция выдает номер элемента. В случае, если число Key не встречается в массиве A, результат функции равен -1.

---

Примечание: Индекс массива начинается с нуля!

Function BinarySearch (A: Array of integer; Lb, Ub, Key: integer): integer;
var M: integer;
begin
  BinarySearch := -1;
  repeat
    M := (Lb + Ub) div 2;
    if (Key < A[M]) then
      Ub := M - 1
    else if (Key > A[M]) then
      Lb := M + 1
    else
    begin
      BinarySearch := M;
      exit;
    end;
  until Lb > Ub;
end;
 
const X: array[0..4] of integer = (2,5,6,8,9);
var n: integer;
begin
     write('Enter number to search: '); readln(n);
     writeln(BinarySearch (X,0,4,n));
end.

Поиск наименьшего элемента массива

Ищет наименьший элемент в массиве простым перебором. Если заменить знак "<" на ">", то можно искать наибольший элемент.

(*******************************************************
Функция для поиска наименьшего элемента.
Принимает:
    *массив значений a с индексами элементов от 0 до N-1
    *число элементов
Возвращает:
    *номер наименьшего элемента
*******************************************************)
function FindLeastElement (const a : array of Real; const N : Integer): Integer;
var
    I, result   :   Integer;
begin
    result := 0;
 
    for I := 1 to N - 1 do
        if A[result] > A[i] then
           result:=i;
 
    FindLeastElement := result;
end;

Поиск подпоследовательности в массиве (простой)

Функция осуществляет поиск первого вхождения массива W в массив T, в результате функция выдает номер первого элемента в массиве T начиная с которого встречается массив W. В случае, если массив W не встречается в массиве T результат функции равен -1.

Поиск осуществляется методом простого перебора, поэтому скорость работы функции не высока, но зато не занимается дополнительной памяти, и алгоритм прост в использовании.

{ массив W с индексами элементов от 0 до M - 1
  массив T с индексами элементов от 0 до N - 1 }
function SimpleSearch (
  W, T: array of byte;
  m, n : LongInt
  ): LongInt;
 
var
     i, j ,k: byte;
     Result: longint;
 
begin
     Result := -2;
     j := 0;
     if m <= n then
     begin
          i := 0;
          repeat
               if W[0] = T[i] then
               begin
                    j := 0;
                    k := i;
                    repeat
                         inc (j);
                         inc (k);
                    until (j >= m) OR (W[j] <> T[k]);
                    if j = m then
                    begin
                         Result := i;
                         break;
                    end;
               end;
               if (j >= m) OR (i > n - m) then
                  Result := -1;
               inc (i);
          until (Result = -1);
     end;
 
     SimpleSearch := Result;
end;
 
const
     Asize = 2;
     Bsize = 4;
     A: array [0 .. Asize - 1] of byte = (4,8);
     B: array [0 .. Bsize - 1] of byte = (3,4,4,8);
 
begin
     writeln (SimpleSearch (A, B, Asize, Bsize))
end.

Сообщение отредактировано: volvo877 - 22.08.09, 10:20

[Romtek]

Поиск подпоследовательности в массиве (алгоритм СДВИГ-И)


Функция осуществляет поиск первого вхождения массива W в массив T, в результате функция выдает номер первого элемента в массиве T, начиная с которого встречается массив W. В случае, если массив W не встречается в массиве T результат функции равен -1.

Const
   Max = 32;
 
Function ExactShiftAND (W, T: Array of Byte; m, n: Longint): Longint;
var
   {Result,}
   BitT: Longint;
   Bit: array[0..Max] of Longint;
   CVTab: array [0..255] of Longint;
   i, R: word;
 
begin
     BitT := 1;
     Result := -1;
 
     for i := 0 to Max - 1 do Bit[i] := 1 shl i;
 
     FillChar (CVTab, SizeOf (CVTab), 0);
 
     for i := 0 to M - 1 do
         CVTab[W[i]] := CVTab[W[i]] OR Bit[i];
 
     i := 0;
     R := 0;
     While (Result = -1) AND (i < n) do
     begin
          R := R shl 1;
          R := R OR 1;
          R := R AND CVTab[T[i]];
          If (R AND Bit[m - 1] <> 0) then
             Result := i - m + 1;
          inc (i);
     end;
 
     ExactShiftAND := Result;
end;
 
const
     Asize = 2;
     Bsize = 4;
     A: array [0 .. Asize - 1] of byte = (4,8);
     B: array [0 .. Bsize - 1] of byte = (3,4,4,8);
 
begin
     writeln (ExactShiftAND (A, B, Asize, Bsize));
     readln;
end.

[Romtek]

Нечёткий поиск (Fuzzy search)
>> Расстояние (разность) между двумя строками. Функция Левенштейна

Levenshtein distance - метрика для строк, определяющая степень их близости. Применяется для приближенного поиска вхождения подстроки.

Цитата

• Что на этой страничке подразумевается под поиском на неточное равенство?
  Под поиском на неточное равенство, или под поиском по сходству (английский термин – fuzzy search) на этом сайте подразумевается, прежде всего, поиск в массиве текстовой информации по ключевым словам или по-другому терминам. Термины могут не совпадать со словами текстовых документов, а быть только «похожими». Кроме того, в разделе «Статьи» можно найти информацию по поиску в общих метрических пространствах.
• А зачем он нужен?
  Как мне кажется, поиск по сходству нужен по двум причинам. Во-первых, человек может не всегда знать точное написание слова, например, если слово является научным термином. Так, количество медицинских и/или биологических терминов превышает десять миллионов. Во-вторых, электронные документы содержат ошибки, что иногда не позволяет найти нужную информацию.
  Особенно это актуально, если нужно найти редкий термин (то есть выборка документов очень маленькая), при том, что термин указан в документе с ошибкой. Пробовали ли вы когда-нибудь искать с помощью Яндекса по ключевому слову «хэширование»? Если да, то вы наверняка уже заметили, что если искать по ключевому слову «хеширование», то результаты поиска отличаются.
• Что же понимается под «похожестью» ключевых слов запросов и слов документа?
  Существует бесконечно много способов определения меры «похожести». Наиболее известной является функция (метрика) Левенштейна, которую также называют расстоянием редактирования. Получили распространение также функции, которые рассчитывают меру близости по количеству общих подстрок определенной длины.
• Так что же все-таки представляет из себя эта функция Левенштейна?
  Если считать все типы ошибок, такие, как удаление, добавление и замены символа равноправными, то расстояние редактирование равно минимальному количеству операций редактирования, которые преобразуют одно слово в другое.

{ Автор: Андрей aka wicked, wilk@ua.fm, ICQ:92356239, Тернополь }

Цитата

реализация функции в принципе соответствует описанию с одной оговоркой:
матрица из описания заменена статическим буфером, длина которого
равна удвоенной максимальной длине строк
это сделано для:
1) экономии памяти и во избежание её перераспределений
2) повышения быстродействия (у меня функция работает в обработчике onfilterRecord)
таким образом, в реализации половинами буфера представлены только
две последние строки матрицы, которые меняются местами каждую
итерацию внешнего цикла (по i)... для определения того, какая из половин
буфера является "нижней строкой", служит переменная flip
т. е. при flip = false первая половина буфера является предпоследней
строкой, а вторая - последней; при flip = true наоборот,
первая половина - последняя строка, вторая половина - предпоследняя

const cuthalf = 100;
   { константа, ограничивающая макс. длину обрабатываемых строк }
 
var buf: array [0..((cuthalf * 2) - 1)] of integer;
   { рабочий буффер, заменяет матрицу, представленную в описании }
 
function min3(a, b, c: integer): integer; { вспомогательная функция }
var
     result: integer;
begin
     result := a;
     if b < Result then Result := b;
     if c < Result then Result := c;
 
     min3 := result;
end;
 
function LeveDist(s, t: string): integer;
var
     i, j, m, n: integer;
     cost: integer;
     flip: boolean;
     result: integer;
begin
     s := copy(s, 1, cuthalf - 1);
     t := copy(t, 1, cuthalf - 1);
     m := length(s);
     n := length(t);
     if m = 0 then Result := n
     else
          if n = 0 then Result := m
          else
          begin
               flip := false;
               for i := 0 to n do buf[i] := i;
               for i := 1 to m do
               begin
                    if flip then buf[0] := i
                    else buf[cuthalf] := i;
 
                    for j := 1 to n do
                    begin
                         if s[i] = t[j] then cost := 0
                         else cost := 1;
 
                         if flip then
                              buf[j] :=
                                   min3(
                                        (buf[cuthalf + j] + 1),
                                        (buf[j - 1] + 1),
                                        (buf[cuthalf + j - 1] + cost)
                                   )
                         else
                              buf[cuthalf + j] :=
                                   min3(
                                        (buf[j] + 1),
                                        (buf[cuthalf + j - 1] + 1),
                                        (buf[j - 1] + cost)
                                   );
                    end;
                    flip := not flip;
               end;
 
               if flip then Result := buf[cuthalf + n]
               else Result := buf[n];
          end;
     LeveDist := Result;
end;
 
begin
     writeln (LeveDist ('Pascal', 'Paskal'));
     readln;
end.

Ссылки:
http://www.merriampark.com/ld.htm
http://itman.narod.ru/index.htm

Сообщение отредактировано: volvo877 - 22.08.09, 10:38