[elpa] master 27b98bb 03/24: Add 'de-bruijn option for avy-style

[Oleh Krehel]

branch: master
commit 27b98bb73044cfe61233d065b8f06bd80cf4867b
Author: Tassilo Horn <address@hidden>
Commit: Oleh Krehel <address@hidden>

    Add 'de-bruijn option for avy-style
    
    * avy.el (avy-style): New choice option.
    (avy--de-bruijn): New defun.
    (avy--path-alist-1): New defun.
    (avy--group-by): New defun.
    (avy--path-alist-to-tree): New defun.
    (avy-tree-de-bruijn): New defun, semi-compatible with `avy-tree'.
    (avy--process): Use `avy-tree-de-bruijn' when `avy-style' is 'de-bruijn.
    (avy--style-fn): Use `avy--overlay-at-full' when `avy-style' is
    'de-bruijn.
    
    Fixes #51
    Re #5
    
    TODO: When tree produced by `avy-tree-de-bruijn' is traversed
    depth-first, the results should be in-order of their appearance in the
    window. Only in this case the overlay functions will work correctly,
    since they need to be applied sequentially from window end to window
    start.
---
 avy.el |  120 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 118 insertions(+), 2 deletions(-)

diff --git a/avy.el b/avy.el
index 402f7ea..478e5ae 100644
--- a/avy.el
+++ b/avy.el
@@ -82,7 +82,8 @@ Use `avy-styles-alist' to customize this per-command."
           (const :tag "Pre" pre)
           (const :tag "At" at)
           (const :tag "At Full" at-full)
-          (const :tag "Post" post)))
+          (const :tag "Post" post)
+          (const :tag "De Bruijn" de-bruijn)))
 
 (defcustom avy-styles-alist nil
   "Alist of avy-jump commands to the style for each command.
@@ -157,6 +158,118 @@ When nil, punctuation chars will not be matched.
         (nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
         nil))))
 
+(defun avy--de-bruijn (keys n)
+  "De Bruijn sequence for alphabet KEYS and subsequences of length N."
+  (let* ((k (length keys))
+         (a (make-list (* n k) 0))
+         sequence)
+    (cl-labels ((db (T p)
+                  (if (> T n)
+                      (if (eq (% n p) 0)
+                          (setq sequence
+                                (append sequence
+                                        (cl-subseq a 1 (1+ p)))))
+                    (setf (nth T a) (nth (- T p) a))
+                    (db (1+ T) p)
+                    (cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do
+                             (setf (nth T a) j)
+                             (db (1+ T) T)))))
+      (db 1 1)
+      (mapcar (lambda (n)
+                (nth n keys))
+              sequence))))
+
+(defun avy--path-alist-1 (lst seq-len keys)
+  "Build a De Bruin sequence from LST.
+SEQ-LEN is how many elements of KEYS it takes to identify a match."
+  (let ((db-seq (avy--de-bruijn keys seq-len))
+        prev-pos prev-seq prev-win path-alist)
+    ;; The De Bruijn seq is cyclic, so append the seq-len - 1 first chars to
+    ;; the end.
+    (setq db-seq (nconc db-seq (cl-subseq db-seq 0 (1- seq-len))))
+    (cl-labels ((subseq-and-pop ()
+                  (when (nth (1- seq-len) db-seq)
+                    (prog1 (cl-subseq db-seq 0 seq-len)
+                      (pop db-seq)))))
+      (while lst
+        (let* ((cur (car lst))
+               (pos (cond
+                      ;; ace-window has matches of the form (pos . wnd)
+                      ((integerp (car cur)) (car cur))
+                      ;; avy-jump have form ((start . end) . wnd)
+                      ((consp (car cur)) (caar cur))
+                      (t (error "Unexpected match representation: %s" cur))))
+               (win (cdr cur))
+               (path (if prev-pos
+                         (let ((diff (if (eq win prev-win)
+                                         (- pos prev-pos)
+                                       0)))
+                           (when (and (> diff 0) (< diff seq-len))
+                             (while (and (nth (1- seq-len) db-seq)
+                                         (not
+                                          (eq 0 (cl-search
+                                                 (cl-subseq prev-seq diff)
+                                                 (cl-subseq db-seq 0 
seq-len)))))
+                               (pop db-seq)))
+                           (subseq-and-pop))
+                       (subseq-and-pop))))
+          (if (not path)
+              (setq lst nil
+                    path-alist nil)
+            (push (cons path (car lst)) path-alist)
+            (setq prev-pos pos
+                  prev-seq path
+                  prev-win win
+                  lst (cdr lst))))))
+    (nreverse path-alist)))
+
+(defun avy--group-by (fn seq)
+  "Apply FN to each element of SEQ.
+Separate the elements of SEQ into an alist using the results as
+keys.  Keys are compared using `equal'."
+  (let (alist)
+    (while seq
+      (let* ((el (pop seq))
+             (r (funcall fn el))
+             (entry (assoc r alist)))
+        (if entry
+            (setcdr entry (cons el (cdr entry)))
+          (push (list r el) alist))))
+    alist))
+
+(defun avy--path-alist-to-tree (p-alist)
+  "Convert P-ALIST to the format of `avy-tree'."
+  (if (> (length (caar p-alist)) 1)
+      (mapcar (lambda (x)
+                (setcdr x (avy--path-alist-to-tree
+                           (mapcar (lambda (c)
+                                     (cons (cdar c) (cdr c)))
+                                   (cdr x))))
+                x)
+              (avy--group-by #'caar p-alist))
+    (mapcar (lambda (x)
+              (cons (caar x)
+                    (cons 'leaf (cdr x))))
+            p-alist)))
+
+(defun avy-tree-de-bruijn (lst keys)
+  "Coerse LST into a tree.
+The degree of the tree is the length of KEYS.
+KEYS are placed on the internal nodes according to De Bruijn sequences.
+LST elements should be of the form ((BEG . END) WND)."
+  ;; In theory, the De Bruijn sequence B(k,n) has k^n subsequences of length n
+  ;; (the path length) usable as paths, thus that's the lower bound.  Due to
+  ;; partially overlapping matches, not all subsequences may be usable, so it's
+  ;; possible that the path-len must be incremented, e.g., if we're matching
+  ;; for x and a buffer contains xaxbxcx only every second subsequence is
+  ;; usable for the four matches.
+  (let* ((path-len (ceiling (log (length lst) (length keys))))
+         (path-alist (avy--path-alist-1 lst path-len keys)))
+    (while (not path-alist)
+      (cl-incf path-len)
+      (setq path-alist (avy--path-alist-1 lst path-len keys)))
+    (avy--path-alist-to-tree path-alist)))
+
 (defun avy-tree (lst keys)
   "Coerce LST into a balanced tree.
 The degree of the tree is the length of KEYS.
@@ -314,7 +427,9 @@ Use OVERLAY-FN to visualize the decision overlay."
          (t
           (avy--make-backgrounds
            (avy-window-list))
-          (avy-read (avy-tree candidates avy-keys)
+          (avy-read (if (eq avy-style 'de-bruijn)
+                        (avy-tree-de-bruijn candidates avy-keys)
+                      (avy-tree candidates avy-keys))
                     overlay-fn
                     #'avy--remove-leading-chars)))
     (avy--done)))
@@ -537,6 +652,7 @@ LEAF is normally ((BEG . END) . WND)."
     (at #'avy--overlay-at)
     (at-full 'avy--overlay-at-full)
     (post #'avy--overlay-post)
+    (de-bruijn #'avy--overlay-at-full)
     (t (error "Unexpected style %S" style))))
 
 (defun avy--generic-jump (regex window-flip style)