Question

I want to implement the vim commandT plugin in emacs. This code is mostly a translation from the matcher.

I’ve got some elisp here that’s still too slow to use on my netbook –
how can I speed it up?

(eval-when-compile (require 'cl))
(defun commandT-fuzzy-match (choices search-string)
  (sort (loop for choice in choices
              for score = (commandT-fuzzy-score choice search-string (commandT-max-score-per-char choice search-string))
              if (> score 0.0) collect (list score choice))
        #'(lambda (a b) (> (first a) (first b)))
        ))

(defun* commandT-fuzzy-score (choice search-string &optional (score-per-char (commandT-max-score-per-char choice search-string)) (choice-pointer 0) (last-found nil))
  (condition-case error
      (loop for search-char across search-string
            sum (loop until (char-equal search-char (elt choice choice-pointer))
                      do (incf choice-pointer)
                      finally return (let ((factor (cond (last-found (* 0.75 (/ 1.0 (- choice-pointer last-found))))
                                                         (t 1.0))))
                                       (setq last-found choice-pointer)
                                       (max (commandT-fuzzy-score choice search-string score-per-char (1+ choice-pointer) last-found)
                                            (* factor score-per-char)))))
    (args-out-of-range 0.0)   ; end of string hit without match found.
    ))

(defun commandT-max-score-per-char (choice search-string)
  (/ (+ (/ 1.0 (length choice)) (/ 1.0 (length search-string))) 2))

Be sure to compile that part, as that already helps a lot.
And a benchmark:

(let ((choices (split-string (shell-command-to-string "curl http://sprunge.us/FcEL") "\n")))
  (benchmark-run-compiled 10
      (commandT-fuzzy-match choices "az")))

Answer 1

Here are some micro optimizations you can try:

• Use car-less-than-car instead of your lambda expression. This has no visible effect since the time is not spent in sort but in commandT-fuzzy-score.
• Use defun instead of defun*: those optional arguments with a non-nil default have a non-negligible hidden cost. This reduces the GC cost by almost half (and you started with more than 10% of the time spent in the GC).
• (* 0.75 (/ 1.0 XXX)) is equal to (/ 0.75 XXX).
• use eq instead of char-equal (that changes the behavior to always be case-sensitive, tho). This makes a fairly large difference.
• use aref instead of elt.
• I don’t understand why you pass last-found in your recursive call, so I obviously don’t fully understand what your algorithm is doing. But assuming that was an error, you can turn it into a local variable instead of passing it as an argument. This saves you time.
• I don’t understand why you make a recursive call for every search-char that you find, instead of only for the first one. Another way to look at this is that your max compares a “single-char score” with a “whole search-string score” which seems rather odd. If you change your code to do the max outside of the two loops with the recursive call on (1+ first-found), that speeds it up by a factor of 4 in my test case.
• The multiplication by score-per-char can be moved outside of the loop (this doesn’t seem to be true for your original algorithm).

Also, the Elisp as implemented in Emacs is pretty slow, so you’re often better off using “big primitives” so as to spend less time interpreting Elisp (byte-)code and more time running C code. Here is for example an alternative implementation (not of your original algorithm but of the one I got after moving the max outside of the loops), using regexp pattern maching to do the inner loop:

(defun commandT-fuzzy-match-re (choices search-string)
  (let ((search-re (regexp-quote (substring search-string 0 1)))
        (i 1))
    (while (< i (length search-string))
      (setq search-re (concat search-re
                              (let ((c (aref search-string i)))
                                (format "[^%c]*\\(%s\\)"
                                        c (regexp-quote (string c))))))
      (setq i (1+ i)))

    (sort
     (delq nil
           (mapcar (lambda (choice)
                     (let ((start 0)
                           (best 0.0))
                       (while (string-match search-re choice start)
                         (let ((last-found (match-beginning 0)))
                           (setq start (1+ last-found))
                           (let ((score 1.0)
                                 (i 1)
                                 (choice-pointer nil))
                             (while (setq choice-pointer (match-beginning i))
                               (setq i (1+ i))
                               (setq score (+ score (/ 0.75 (- choice-pointer last-found))))
                               (setq last-found choice-pointer))
                             (setq best (max best score)))))
                       (when (> best 0.0)
                         (list (* (commandT-max-score-per-char
                                   choice search-string)
                                  best)
                               choice))))
                   choices))
     #'car-less-than-car)))