Use radix-tree for string arrays

[Yuchen Pei]

Hello,

In implementing a command to convert a list of urls to a radix tree
based on path components, I made a slight generalization to
radix-tree.el to take a comparison function, see attached diff and
functions utilising the generalised radix tree.

I'll be happy to spend more time on a patch if there's interest in
incorporating it.

@@ -1,6 +1,6 @@
 ;;; radix-tree.el --- A simple library of radix trees  -*- lexical-binding: t; 
-*-
 
-;; Copyright (C) 2016-2023 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2022 Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Keywords:
@@ -22,6 +22,11 @@
 
 ;;; Commentary:
 
+;; NOTE: This is a modified version of radix-tree that comes builtin
+;; with emacs. It allows different compare functions and type. One use
+;; is to build a radix tree of list of string, e.g. from a filesystem
+;; hierarchy.
+
 ;; There are many different options for how to represent radix trees
 ;; in Elisp.  Here I chose a very simple one.  A radix-tree can be either:
 ;; - a node, of the form ((PREFIX . PTREE) . RTREE) where PREFIX is a string
@@ -41,12 +46,14 @@
 ;; data structure harder to read (by a human) when printed out.
 
 ;;; Code:
+(defvar radix-tree-compare-function 'compare-strings)
+(defvar radix-tree-type 'string)
 
 (defun radix-tree--insert (tree key val i)
   (pcase tree
     (`((,prefix . ,ptree) . ,rtree)
      (let* ((ni (+ i (length prefix)))
-            (cmp (compare-strings prefix nil nil key i ni)))
+            (cmp (funcall radix-tree-compare-function prefix nil nil key i 
ni)))
        (if (eq t cmp)
            (let ((nptree (radix-tree--insert ptree key val ni)))
              `((,prefix . ,nptree) . ,rtree))
@@ -71,12 +78,13 @@
   (pcase tree
     (`((,prefix . ,ptree) . ,rtree)
      (let* ((ni (+ i (length prefix)))
-            (cmp (compare-strings prefix nil nil key i ni)))
+            (cmp (funcall radix-tree-compare-function prefix nil nil key i 
ni)))
        (if (eq t cmp)
            (pcase (radix-tree--remove ptree key ni)
              ('nil rtree)
              (`((,pprefix . ,pptree))
-              `((,(concat prefix pprefix) . ,pptree) . ,rtree))
+              `((,(seq-concatenate radix-tree-type prefix pprefix) . ,pptree) .
+                ,rtree))
              (nptree `((,prefix . ,nptree) . ,rtree)))
          (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
            (if (zerop n)
@@ -91,7 +99,7 @@
   (pcase tree
     (`((,prefix . ,ptree) . ,rtree)
      (let* ((ni (+ i (length prefix)))
-            (cmp (compare-strings prefix nil nil string i ni)))
+            (cmp (funcall radix-tree-compare-function prefix nil nil string i 
ni)))
        (if (eq t cmp)
            (radix-tree--lookup ptree string ni)
          (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
@@ -109,7 +117,7 @@
 ;;     (pcase tree
 ;;       (`((,prefix . ,ptree) . ,rtree)
 ;;        (let* ((ni (+ i (length prefix)))
-;;               (cmp (compare-strings prefix nil nil string i ni))
+;;               (cmp (funcall radix-tree-compare-function prefix nil nil 
string i ni))
 ;;               ;; FIXME: We could compute nrtree more efficiently
 ;;               ;; whenever cmp is not -1 or 1.
 ;;               (nrtree (radix-tree--trim rtree string i)))
@@ -130,7 +138,7 @@
   (pcase tree
     (`((,prefix . ,ptree) . ,rtree)
      (let* ((ni (+ i (length prefix)))
-            (cmp (compare-strings prefix nil nil string i ni))
+            (cmp (funcall radix-tree-compare-function prefix nil nil string i 
ni))
             ;; FIXME: We could compute prefixes more efficiently
             ;; whenever cmp is not -1 or 1.
             (prefixes (radix-tree--prefixes rtree string i prefixes)))
@@ -149,7 +157,7 @@
     (pcase tree
       (`((,prefix . ,ptree) . ,rtree)
        (let* ((ni (+ i (length prefix)))
-              (cmp (compare-strings prefix nil nil string i ni)))
+              (cmp (funcall radix-tree-compare-function prefix nil nil string 
i ni)))
          (if (eq t cmp)
              (radix-tree--subtree ptree string ni)
            (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
@@ -222,7 +230,7 @@
   (radix-tree-iter-subtrees
    tree
    (lambda (p s)
-     (let ((nprefix (concat prefix p)))
+     (let ((nprefix (seq-concatenate radix-tree-type prefix p)))
        (pcase s
          ((radix-tree-leaf v) (funcall fun nprefix v))
          (_ (radix-tree-iter-mappings s fun nprefix)))))))

Diff finished.  Wed Jul  5 22:52:53 2023

#+begin_src elisp
(require 'radix-tree)
(defun my-compare-string-arrays (xs1 start1 end1 xs2 start2 end2)
  (let* ((i 0)
         (s1 (or start1 0))
         (e1 (or end1 (length xs1)))
         (s2 (or start2 0))
         (e2 (or end2 (length xs2)))
         (l1 (- e1 s1))
         (l2 (- e2 s2))
         (cmp t))
    (while (and (< i l1) (< i l2) (eq t cmp))
      (setq cmp (compare-strings (elt xs1 (+ s1 i)) nil nil
                                 (elt xs2 (+ s2 i)) nil nil))
      (setq i (1+ i)))
    (cond ((and (numberp cmp) (< cmp 0)) (- i))
          ((and (numberp cmp) (> cmp 0)) i)
          ((= l1 l2) t)
          ((< l1 l2) (- i))
          (t         i))))

(defun my-radix-tree-from-list ()
  (goto-char (point-min))
  (let ((result radix-tree-empty)
        (radix-tree-compare-function 'my-compare-string-arrays))
    (while (not (eobp))
      (let ((line (vconcat
                   (split-string
                    (buffer-substring-no-properties
                     (point)
                     (progn (forward-line 1) (1- (point))))
                    "/"))))
        (setq result
              (radix-tree-insert result line t))))
    result))

(defun my-kill-radix-tree-from-list ()
  (interactive)
  (let ((max-lisp-eval-depth 8000))
    (kill-new (pp (my-radix-tree-from-list)))))
#+end_src

Best,
Yuchen

-- 
PGP Key: 47F9 D050 1E11 8879 9040  4941 2126 7E93 EF86 DFD0
          <https://ypei.org/assets/ypei-pubkey.txt>