[kakt00z]

Здравствуйте, вопрос такой.
есть 2 строки, к примеру:
s1 "Положение клапана на байпасе воздухоподогревателя 2-ой ступени"
s2 "Положение клапана на байпасе\Pвоздухоподогревателя 1-ой ступени"
Хотелось бы знать некий "процент их совпадения"...
конечная цель - например - отсортировать перечень в соответствии с уже существующим "похожим"
более конкретно изъясниться пока что не придумаю как
есть следующий вариант:

Код:

[Выделить все]

 ;(setq s1 (vla-get-TextString (vlax-ename->vla-object (car (nentsel)))))
;(setq s2 (vla-get-TextString (vlax-ename->vla-object (car (nentsel)))))
(defun str|compare (s1 s2 / len lst i j)
  (setq len (apply 'min (mapcar 'strlen (list s1 s2))))
  (setq lst '())
  (setq i -1)
  (while (< (setq i (1+ i)) len)
    (setq j -1)
    (while (< (setq j (1+ j)) len)
      (setq lst (append lst (list (vl-string-mismatch s1 s2 i j T))))
      )
    )
  (length lst)
  (setq lst (vl-remove 0 lst))
  ;(setq lst (vl-remove 1 lst))
  ;(setq lst (vl-remove 2 lst))
  (/ (+ 0.0 (apply '+ lst)) (+ (/ (expt len 2) 2) 1.0))
  );defun

но тут недостатки :
1) он слишком медленный
2) если разница в 1 символ в середине строки, то это неоправданно снижает результат
если у кого-нибудь есть опыт или идеи в подобном - буду благодарен

[Do$]

Может быть vl-string->list и с кодами работать?

[Дима_]

Алгоритм давно придуман

[kakt00z]

это даже больше чем я ожидал, спасибо!
завтра попробую реализовать, и, даже если результат не устроит - всёравно будет интересно

----- добавлено через ~21 ч. -----
если вдруг кому-нибудь будет интересно - вот что получилось

Код:

[Выделить все]

 ;(setq str (vla-get-TextString (vlax-ename->vla-object (car (nentsel)))))

(defun str|compare-SoundexWordEncode (str / strc1 strc2 strc3)
  (setq strc1 (mapcar 'chr (vl-string->list (strcase (vl-string-trim " \\~" str) T))))
  (setq strc2 (cons (car strc1)
(mapcar
  '(lambda (c)	;(setq c "n")
     (cond
       ((member c '("a" "e" "h" "i" "o" "u" "w" "y")) "")
       ((member c '("b" "f" "p" "v")) "1")
       ((member c '("c" "g" "j" "k" "q" "s" "x" "z")) "2")
       ((member c '("d" "t")) "3")
       ((member c '("l")) "4")
       ((member c '("m" "n")) "5")
       ((member c '("r")) "6")
       (T "#err#")
       )
     )
  (cdr strc1)
  )))
  (setq strc3 '())
  (foreach x (reverse (vl-remove "" strc2))
    (if (null (= x (car strc3)))
      (setq strc3 (append (list x) strc3))
      )
    )
  (while (< 4 (length strc3))
     (setq strc3 (reverse (cdr (reverse strc3))))
     )
  (while (> 4 (length strc3))
     (setq strc3 (append strc3 (list "0")))
     )
  (apply 'strcat strc3)
  );defun

(defun str|compare-SoundexWordEncodeRU (str / strc1 strc2 strc3)
  (setq strc1 (mapcar 'chr (vl-string->list (strcase (vl-string-trim " \\~" str) T))))
  (setq strc2 (cons (car strc1)
(mapcar
  '(lambda (c)	;(setq c "n")
     (cond
       ((member c '("а" "о" "у" "ы" "э"  "я" "ё" "ю" "и" "е" "й")) "")
       ((member c '("б" "п")) "1")
       ((member c '("г" "к" "х")) "2")
       ((member c '("в" "ф")) "3")
       ((member c '("д" "т" "ц")) "4")
       ((member c '("ж" "ш" "щ" "ч")) "5")
       ((member c '("з" "с")) "6")
       ((member c '("л" "м" "н")) "7")
       ((member c '("р")) "8")
       ((member c '("ъ" "ь")) "9")
       (T "#err#")
       )
     )
  (cdr strc1)
  )))
  (setq strc3 '())
  (foreach x (reverse (vl-remove "" strc2))
    (if (null (= x (car strc3)))
      (setq strc3 (append (list x) strc3))
      )
    )
  (while (< 6 (length strc3))
     (setq strc3 (reverse (cdr (reverse strc3))))
     )
  (while (> 6 (length strc3))
     (setq strc3 (append strc3 (list "0")))
     )
  (apply 'strcat strc3)
  );defun