From 722c13a8fc093bc67b9be444547571d544cb79a0 Mon Sep 17 00:00:00 2001 From: Tom Willemsen Date: Wed, 30 Jun 2010 20:59:12 +0200 Subject: Switched over from dotemacs to doteverything --- .emacs.d/fuzzy.el | 255 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 255 insertions(+) create mode 100644 .emacs.d/fuzzy.el (limited to '.emacs.d/fuzzy.el') diff --git a/.emacs.d/fuzzy.el b/.emacs.d/fuzzy.el new file mode 100644 index 0000000..c69150a --- /dev/null +++ b/.emacs.d/fuzzy.el @@ -0,0 +1,255 @@ +;;; fuzzy.el --- Fuzzy matching utilities + +;; Copyright (C) 2010 Tomohiro Matsuyama + +;; Author: Tomohiro Matsuyama +;; Keywords: convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'regexp-opt) + +(defgroup fuzzy nil + "Fuzzy matching utilities." + :group 'convenience + :prefix "fuzzy-") + +(defcustom fuzzy-accept-error-rate 0.10 + "Error threshold." + :group 'fuzzy) + +(defvar fuzzy-accept-length-difference 2) + +(defvar fuzzy-regexp-some-char (format "\\w\\{0,%s\\}" fuzzy-accept-length-difference)) + + + +;;; Functions + +(defun fuzzy-reverse-string (string) + (apply 'string (nreverse (append string nil)))) + +(defun fuzzy-regexp-compile (string) + (labels ((oddp (n) (eq (logand n 1) 1)) + (evenp (n) (eq (logand n 1) 0)) + (opt (n) (regexp-opt-charset (append (substring string + (max 0 (- n 1)) + (min (length string) (+ n 2))) nil)))) + (concat + "\\(" + (loop for i below (length string) + for c = (if (evenp i) (opt i) fuzzy-regexp-some-char) + concat c) + "\\|" + (loop for i below (length string) + for c = (if (oddp i) (opt i) fuzzy-regexp-some-char) + concat c) + "\\)"))) + +(defalias 'fuzzy-edit-distance 'fuzzy-jaro-winkler-distance) + +(defun fuzzy-jaro-winkler-distance (s1 s2) + "http://en.wikipedia.org/wiki/Jaro-Winkler_distance" + (let* ((l1 (length s1)) + (l2 (length s2)) + (r (max 1 (1- (/ (max l1 l2) 2)))) + (m 0) + (tr 0) + (p 0) + cs1 cs2) + (loop with seen = (make-vector l2 nil) + for i below l1 + for c1 = (aref s1 i) do + (loop for j from (max 0 (- i r)) below (min l2 (+ i r)) + for c2 = (aref s2 j) + if (and (char-equal c1 c2) + (null (aref seen j))) do + (push c1 cs1) + (aset seen j c2) + (incf m) + and return nil) + finally + (setq cs1 (nreverse cs1) + cs2 (loop for i below l2 + for c = (aref seen i) + if c collect c))) + (loop for c1 in cs1 + for c2 in cs2 + if (not (char-equal c1 c2)) do + (incf tr)) + (loop for i below (min m 5) + for c1 across s1 + for c2 across s2 + while (char-equal c1 c2) do + (incf p)) + (if (eq m 0) + 0.0 + (setq m (float m)) + (let* ((dj (/ (+ (/ m l1) (/ m l2) (/ (- m (/ tr 2)) m)) 3)) + (dw (+ dj (* p 0.1 (- 1 dj))))) + dw)))) + +;; this function should be compiled +(byte-compile 'fuzzy-jaro-winkler-distance) + +(defun fuzzy-match (s1 s2 &optional function) + (or function (setq function 'fuzzy-edit-distance)) + (and (<= (abs (- (length s1) (length s2))) + fuzzy-accept-length-difference) + (>= (funcall function s1 s2) + (- 1 fuzzy-accept-error-rate)))) + +(defun fuzzy-all-completions (string collection) + "all-completions family with fuzzy matching." + (loop with length = (length string) + for str in collection + for s = (substring str 0 (min (length str) + (+ length fuzzy-accept-length-difference))) + if (fuzzy-match string s) + collect str)) + + + +;;; Search and Incremental Search + +(defvar fuzzy-search-cache nil) +(defvar fuzzy-search-cache-string nil) + +(defun fuzzy-search-cache-activate () + (setq fuzzy-search-cache (make-hash-table)) + (setq fuzzy-search-cache-string nil)) + +(defun fuzzy-search-cache-deactive () + (setq fuzzy-search-cache nil) + (setq fuzzy-search-cache-string nil)) + +(defun fuzzy-search-edit-distance (s1 s2) + (or (and fuzzy-search-cache + (cond + ((null fuzzy-search-cache-string) + (setq fuzzy-search-cache-string s1) + nil) + ((not (equal fuzzy-search-cache-string s1)) + (setq fuzzy-search-cache-string s1) + (clrhash fuzzy-search-cache) + nil) + (t)) + (gethash s2 fuzzy-search-cache)) + (let ((d (fuzzy-edit-distance s1 s2))) + (if fuzzy-search-cache + (puthash s2 d fuzzy-search-cache)) + d))) + +(defun fuzzy-search-match (s1 s2) + (fuzzy-match s1 s2 'fuzzy-search-edit-distance)) + +(defun fuzzy-search-forward (string &optional bound noerror count) + (let* ((regexp (fuzzy-regexp-compile string)) + match-data) + (save-excursion + (while (and (null match-data) + (re-search-forward regexp bound t)) + (if (fuzzy-search-match string (match-string 1)) + (setq match-data (match-data)) + (goto-char (1+ (match-beginning 1)))))) + (when match-data + (store-match-data match-data) + (goto-char (match-end 1))))) + +(defun fuzzy-search-backward (string &optional bound noerror count) + (let* ((regexp (fuzzy-regexp-compile string)) + match-data begin end) + (save-excursion + (while (and (null match-data) + (re-search-backward regexp bound t)) + (setq begin (match-beginning 1) + end (match-end 1)) + (store-match-data nil) + (goto-char (max (point-min) (- begin (* (length string) 2)))) + (while (re-search-forward regexp end t) + (if (fuzzy-search-match string (match-string 1)) + (setq match-data (match-data)) + (goto-char (1+ (match-beginning 1))))) + (unless match-data + (goto-char begin))) + (if match-data + (progn + (store-match-data match-data) + (goto-char (match-beginning 1))) + (store-match-data nil))))) + +(defvar fuzzy-isearch nil) +(defvar fuzzy-isearch-failed-count 0) +(defvar fuzzy-isearch-enabled 'on-failed) +(defvar fuzzy-isearch-original-search-fun nil) +(defvar fuzzy-isearch-prefix "[FUZZY] ") + +(defun fuzzy-isearch-activate () + (setq fuzzy-isearch t) + (setq fuzzy-isearch-failed-count 0) + (fuzzy-search-cache-activate)) + +(defun fuzzy-isearch-deactivate () + (setq fuzzy-isearch nil) + (setq fuzzy-isearch-failed-count 0) + (fuzzy-search-cache-deactive)) + +(defun fuzzy-isearch () + (cond (isearch-word + (if isearch-forward 'word-search-forward 'word-search-backward)) + (isearch-regexp + (if isearch-forward 're-search-forward 're-search-backward)) + ((or fuzzy-isearch + (eq fuzzy-isearch-enabled 'always) + (and (eq fuzzy-isearch-enabled 'on-failed) + (null isearch-success) + isearch-wrapped + (> (setq fuzzy-isearch-failed-count (1+ fuzzy-isearch-failed-count)) + 1))) + (unless fuzzy-isearch + ;(goto-char isearch-opoint) + (fuzzy-isearch-activate)) + (if isearch-forward 'fuzzy-search-forward 'fuzzy-search-backward)) + (t + (if isearch-forward 'search-forward 'search-backward)))) + +(defun fuzzy-isearch-end-hook () + (fuzzy-isearch-deactivate)) + +(defun turn-on-fuzzy-isearch () + (interactive) + (setq fuzzy-isearch-original-search-fun isearch-search-fun-function) + (setq isearch-search-fun-function 'fuzzy-isearch) + (add-hook 'isearch-mode-end-hook 'fuzzy-isearch-end-hook)) + +(defun turn-off-fuzzy-isearch () + (interactive) + (setq isearch-search-fun-function fuzzy-isearch-original-search-fun) + (remove-hook 'isearch-mode-end-hook 'fuzzy-isearch-end-hook)) + +(defadvice isearch-message-prefix (after fuzzy-isearch-message-prefix activate) + (if fuzzy-isearch + (setq ad-return-value (concat fuzzy-isearch-prefix ad-return-value)) + ad-return-value)) + +(provide 'fuzzy) +;;; fuzzy.el ends here -- cgit v1.2.3-54-g00ecf