forum.clarionlife.net

Код: Выделить всё

! Трансформация строки в набор триграмм для нечёткого поиска
StringToTrigram  Procedure(String sField_,*G_Trigram gTrigram)

!G_Trigram  Group,Type
!Object       Long
!Index        Long
!Mass         String(3),Dim(1000)
!           end

eSymbols  Equate('ABCDEFGHIJKLMNOPQRSTUVWXYZАБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ0123456789')
cData     CString(Len(sField_) * 2 + 1)
lCount    Long,Auto
lMax      Long(Maximum(gTrigram.Mass,1)) ! Ограничение по размеру массива триграмм 
lFlag     Byte(True)

  Code
  Clear(gTrigram)                        ! Сбросить значение триграммы
  sField_ = Clip(Left(Upper(sField_)))   ! Нормализация исходной строки
  
  Loop lCount = 1 to Len(Clip(sField_))                                         
    If sField_[lCount] = ' ' and lFlag   ! Слово внутри строки начинается с 2-х пробелов 
       lFlag = False                     ! Убираем повторение пробелов внутри строки
       cData = cData & '  '
                                         ! Только алфавитно-цифровые символы 
    elsIf InString(sField_[lCount],eSymbols,1,1)
       cData = cData & sField_[lCount]
       lFlag = True
    end   
  end
  
  ! Строка начинается с 2-х пробелов и заканчивается 1-им пробелом
  If Clip(cData) <> '' then cData = '  ' & Clip(cData) & ' '.
  
  ! Ну и, собственно, теперь разбиение строки на триграммы    
  Loop lCount = 1 to Len(cData) - 2
                   ! Контроль ограничение по размеру массива триграмм
    If lCount > lMax then Break.     
                   ! Триграмма не может заканчиваться на два пробела
    If cData[(lCount+1):(lCount+2)] <> '  '    
       gTrigram.Index += 1
       gTrigram.Mass[gTrigram.Index] = cData[(lCount):(lCount+2)] ! = Sub(cData,lCount,3)
    end   
  end

Код: Выделить всё

! Неточный поиск значения tFind_ в строке tStr_ по триграммам
FindTrigram  Procedure(*G_Trigram tStr_,*G_Trigram tFind_)

lIndex1   Long,Auto
lIndex2   Long,Auto
lReplay   Long(0)
aFlag     Byte(False),Dim(MaxDimTrigram)  ! Признак нахождения триграммы в строке
 
  Code  
  Loop lIndex1 = 1 to tFind_.Index
    Loop lIndex2 = 1 to tStr_.Index
      If tStr_.Mass[lIndex2] = tFind_.Mass[lIndex1] and Not aFlag[lIndex2]
         aFlag[lIndex2] = True
         lReplay += 1
         Break   ! Иначе проблема !!! Проверка: lala -> lalaland = 120% :(  
      end
    end
  end  
  
  Return Round((lReplay * 100) / tFind_.Index,1)  ! Возвращаем процент схожести