На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! Правила ЧаВО (FAQ) разделов Паскаля
В этом разделе разрешено создавать только темы, в которых описано РЕШЕНИЕ какой-либо общей проблемы, или описание какого-либо аспекта языка Паскаль.
Обсуждение уже созданных тем разрешено, но только конструктивное, например указание на ошибку или уточнение имеющегося текста.

Стоит почитать Структуры данных
Модераторы: volvo877, Romtek
  
> Поиск данных , в массивах, строках и других типах данных
    Бинарный поиск в упорядоченном массиве

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

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

    ExpandedWrap disabled
      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.


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

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

    ExpandedWrap disabled
      (*******************************************************
      Функция для поиска наименьшего элемента.
      Принимает:
          *массив значений 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.

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

    ExpandedWrap disabled
      { массив 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 -
      Поиск подпоследовательности в массиве (алгоритм СДВИГ-И)


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

      ExpandedWrap disabled
        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.
        Нечёткий поиск (Fuzzy search)
        >> Расстояние (разность) между двумя строками. Функция Левенштейна

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

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


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

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


        ExpandedWrap disabled
          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 -
        0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
        0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0305 ]   [ 16 queries used ]   [ Generated: 30.05.24, 21:54 GMT ]