A temporary intermeidate step

Now I got almost every functionality that we need, including pdf,
mu4e, magit, et cetera.

1 files changed, 398 insertions, 0 deletions

diff --git a/suffix tree/generalized-suffix-tree.el b/suffix tree/generalized-suffix-tree.el
new file mode 100644
index 0000000..227aea9
--- /dev/null
+++ b/suffix tree/generalized-suffix-tree.el
@@ -0,0 +1,398 @@
+;;; generalized-suffiex-tree.el --- Building a generalized suffix tree -*- lexical-binding: t; -*-
+
+;;; Author: Durand
+;;; Version: 0.0.2
+
+;;; Commentary:
+
+;; Our node is represented as a list of the following elements:
+
+;; number     , from which string this edge comes
+;; start      , which is the starting index of the edge going from its parent
+;;              node to this node
+;; end        , the index of the end of the above edge
+;; suffix-link, the index of the node this node's suffix-link points to
+;; children   , a hash-table of pairs of integers and indices of its
+;;              children
+;; leaf-labels, a list of pairs (number start), where
+;;              number means the number-th string and
+;;              start is the starting position of this edge.
+;;              This element is nil for the internal nodes.
+
+;; To compute the length of the edge going into NODE we use:
+;; (- (min end (1+ position)) start)
+;; which is actually how far the position is on that edge,
+;; if it is on that edge.
+
+;; We use only one terminating symbol, and that is -1.
+
+;;; Code:
+
+;;;###autoload
+(defun gst-min (&rest args)
+  "Return the minimum among ARGS.
+If an argument is 'infty, then it is considered greater than
+every number."
+  (apply #'min (delq nil
+                     (mapcar
+                      (lambda (arg)
+                        (cond
+                         ((number-or-marker-p arg) arg)
+                         ((eq arg 'infty) nil)))
+                      args))))
+
+;;;###autoload
+(defun gst-edge-length (node position num str-lens)
+  "Return the length of the edge into NODE.
+See the comment above this function for the reason
+POSITION and NUM are here."
+  (let* ((node-active-num (car node))
+         (leafp (eq (car (cdr (cdr node))) 'infty))
+         (leaf-labels (cond (leafp (car (nthcdr 5 node))))))
+    (- (cond
+        ((and (/= node-active-num num)
+              leafp)
+         (nth node-active-num str-lens))
+        ((/= node-active-num num)
+         (caddr node))
+        (t (gst-min (caddr node) (1+ position))))
+       (cond
+        ((and (= node-active-num num)
+              leafp)
+         (or (cadr (assoc num leaf-labels #'eq))
+             (cadr node)))
+        (t (cadr node))))))
+
+;;;###autoload
+(defun gst-new-node (tree last-added number start &optional end suffix-start)
+  "Make a new node with START and END as the coming edge.
+NUMBER is the number of string the label belongs to.
+Then add the new node to TREE.
+LAST-ADDED is the number of elements already in the TREE."
+  (let* ((end (or end 'infty) ;; 'infty represents the index of a leaf
+              )
+         (suffix-link 0) ;; The suffix link is initially 0
+         (new-node
+          (cond ((eq end 'infty)
+                 (list number start end suffix-link (make-hash-table)
+                       (list (list number suffix-start))))
+                (t
+                 (list number start end suffix-link (make-hash-table))))))
+    (puthash (1+ last-added) new-node tree)
+    (1+ last-added)))
+
+;;;###autoload
+(defun gst-add-leaf-label (tree leaf number start)
+  "Add a label to LEAF."
+  (let* ((actual-node (gethash leaf tree))
+         (leaf-labels (cdr (cdr (cdr (cdr (cdr actual-node)))))))
+    (cond ((consp leaf-labels)
+           (setcar leaf-labels
+                   (cons (list number start)
+                         (car leaf-labels)))))))
+
+;;;###autoload
+(defun gst-add-suffix-link (tree need-sl node)
+  "If NEED-SL is positive, then add the suffix link.
+In particular, the node corresponding to NEED-SL in TREE
+gets a suffix link pointing to NODE.
+
+This always returns NODE."
+  (cond
+   ((and (> need-sl 1) (/= need-sl node))
+    (setcar (cdr (cdr (cdr (gethash need-sl tree)))) node)))
+  node)
+
+;;;###autoload
+(defun gst-canonize (tree node position active-number active-edge-index active-length active-node
+                          str-lens)
+  "Walk down TREE to find the correct active point."
+  (let* ((actual-node (gethash node tree))
+         (node-edge-length (gst-edge-length actual-node position active-number
+                                            str-lens)))
+    (cond
+     ((>= active-length node-edge-length)
+      (list t
+            active-number
+            (+ active-edge-index
+               node-edge-length)
+            (- active-length
+               node-edge-length)
+            node))
+     (t
+      (list nil
+            active-number
+            active-edge-index
+            active-length
+            active-node)))))
+
+;;;###autoload
+(defsubst gst-aref (strs num index)
+  "Return the INDEX-th element in NUM-th element of STRS."
+  (aref (nth num strs) index))
+
+;;;###autoload
+(defun gst-extend-tree (tree last-added position remain
+                             active-node active-number active-edge-index
+                             active-length character strs num str-lens)
+  "Extend a tree by CHARACTER in NUM-th string of STRS.
+The return value is
+(tree 
+ last-added    remain            active-node
+ active-number active-edge-index active-length)"
+  (let* ((need-sl 0)
+         (remain (1+ remain))
+         continue-p breakp)
+    (while (and (not breakp) (> remain 0))
+      (setq continue-p nil breakp nil)
+      (cond
+       ((= active-length 0)
+        (setq active-edge-index position)
+        (setq active-number num)))
+      (let* ((actual-node (gethash active-node tree))
+             (nxt (cond
+                   (actual-node
+                    (gethash (gst-aref strs active-number active-edge-index)
+                             (cadr (cdr (cdr (cdr actual-node)))))))))
+        (cond
+         ((null nxt)
+          (let ((leaf (gst-new-node tree last-added num position nil
+                                    (- position remain -1))))
+            (setq last-added leaf)
+            (puthash (gst-aref strs active-number active-edge-index)
+                     leaf
+                     (cadr (cdr (cdr (cdr (gethash active-node tree))))))
+            (setq need-sl (gst-add-suffix-link tree need-sl active-node)))
+          ;; rule 2
+          )
+         (t
+          (let* ((result (gst-canonize
+                          tree nxt position active-number
+                          active-edge-index active-length active-node
+                          str-lens)))
+            (cond
+             ((car result)
+              ;; observation 2
+              (setq active-number (car (cdr result)))
+              (setq active-edge-index (car (cdr (cdr result))))
+              (setq active-length (car (cdr (cdr (cdr result)))))
+              (setq active-node (car (cdr (cdr (cdr (cdr result))))))
+              (setq continue-p t))
+             (t
+              (cond
+               ((eq (gst-aref strs
+                              (car (gethash nxt tree))
+                              (+ active-length
+                                 (cadr (gethash nxt tree))))
+                    character)
+                ;; observation 1
+                (setq active-length (1+ active-length))
+                (setq need-sl (gst-add-suffix-link tree need-sl active-node))
+                (setq breakp t)
+                ;; add a label
+                (cond
+                 ((eq character -1)     ; terminating symbol
+                  (gst-add-leaf-label tree nxt num (- position remain -1))))))
+              (cond
+               (breakp)
+               (t ;; splitting
+                (let ((split (gst-new-node
+                              tree last-added (car (gethash nxt tree)) (cadr (gethash nxt tree))
+                              (+ (cadr (gethash nxt tree)) active-length))))
+                  (setq last-added split)
+                  (puthash
+                   (gst-aref strs active-number active-edge-index)
+                   split (cadr (cdr (cdr (cdr (gethash active-node tree))))))
+                  (let ((leaf (gst-new-node tree last-added num position
+                                            nil (- position remain -1))))
+                    (setq last-added leaf)
+                    (puthash character leaf
+                             (cadddr (cdr (gethash split tree))))
+                    (setcar (cdr (gethash nxt tree))
+                            (+ (cadr (gethash nxt tree))
+                               active-length))
+                    (puthash (gst-aref strs
+                                       (car (gethash nxt tree))
+                                       (cadr (gethash nxt tree)))
+                             nxt
+                             (cadddr (cdr (gethash split tree))))
+                    ;; rule 2
+                    (setq need-sl
+                          (gst-add-suffix-link tree need-sl split)))))))))))
+        (cond
+         ((or continue-p breakp))
+         (t
+          (setq remain (1- remain))
+          (cond
+           ((and (eq active-node 1) ; root
+                 (> active-length 0))
+            (setq active-length (1- active-length))
+            (setq active-edge-index
+                  (1+ (- position remain))))
+           (t
+            (setq active-node
+                  (let ((slink (cadddr (gethash active-node tree))))
+                    (cond       ; follow the suffix link or go to root
+                     ((> slink 1) slink)
+                     (t 1))))))))))
+    (list tree last-added remain active-node
+          active-number active-edge-index active-length)))
+
+;;;###autoload
+(defun gst-build-for-strs (strs &optional str-lens)
+  "Build the generalized suffix tree for STRS.
+One can optionally provide STR-LENS to avoid calculating the
+lengths again."
+  (let* ((len (length strs))
+         (index 0)
+         (tree (make-hash-table))
+         (last-added 0)
+         (active-node (gst-new-node tree last-added index -1 -1))
+         (str-lens (or str-lens (mapcar #'length strs))))
+    (setq last-added active-node)
+    (while (< index len)
+      (let* ((position 0)
+             (character (ignore-errors (gst-aref strs index position)))
+             (remain 0)
+             (active-node 1)            ; start from the root
+             (active-number index)
+             (active-edge-index 0)
+             (active-length 0)
+             old-character result)                    ; temporary holder
+        (while character
+          (setq old-character character)
+          (setq result (gst-extend-tree tree last-added position remain
+                                        active-node active-number active-edge-index
+                                        active-length character strs index
+                                        str-lens))
+          (setq tree (pop result))
+          (setq last-added (pop result))
+          (setq remain (pop result))
+          (setq active-node (pop result))
+          (setq active-number (pop result))
+          (setq active-edge-index (pop result))
+          (setq active-length (pop result))
+          (setq position (1+ position))
+          (setq character (ignore-errors (gst-aref strs index position)))
+          (cond
+           ((characterp old-character)
+            (insert (format "After adding character %c:\n" old-character))
+            (gst-print-tree tree
+                            (append (seq-take strs index)
+                                    (list (concat
+                                           (seq-take (nth index strs) position)
+                                           "$"))))
+            (insert "\n\n"))
+           ((= old-character -1)
+            (insert (format "After adding character -1:\n"))
+            (gst-print-tree tree
+                            (seq-take strs (1+ index)))
+            (insert "\n\n")))))
+      (setq index (1+ index))
+      (insert "\n\n"))
+    tree))
+
+;;; Printing
+
+;; This section is not necessary. It is here just to print the trees
+;; to make sure we don't make some strange errors.
+
+(require 'hierarchy)
+(require 'seq)
+
+;;;###autoload
+(defun gst-print-strs (strs)
+  "Print strings STRS nicely."
+  (mapc (lambda (str)
+          (mapc (lambda (char)
+                  (cond ((characterp char) (insert char))
+                        (t (insert ", "))))
+                str))
+        strs))
+
+;;;###autoload
+(defun gst-pretty-hash-table (table)
+  "Only returns the useful parts from a table."
+  (let (keys-values-alist)
+    (maphash
+     (lambda (key value)
+       (setq keys-values-alist
+             (cons
+              (cons key value)
+              keys-values-alist)))
+     table)
+    keys-values-alist))
+
+;;;###autoload
+(defun gst-pretty-node (node)
+  "Outputs a prettified NODE."
+  (format "(%d %d %s %d %s %S)"
+          (car node) (cadr node)
+          (caddr node) (cadddr node)
+          (gst-pretty-hash-table (car (nthcdr 4 node)))
+          (car (nthcdr 5 node))))
+
+;;;###autoload
+(defun gst-print-tree-for-strs (strs)
+  "Print the generalized suffix tree for STRS."
+  (let* ((strs (mapcar (lambda (str)
+                         (vconcat str (list -1)))
+                       strs))
+         (symbol (make-symbol "gtree")))
+    (set symbol (gst-build-for-strs strs))
+    (insert "Generalized suffix tree for: ")
+    (gst-print-strs strs)
+    (delete-region (- (point) 2) (point))
+    (insert ":\n")
+    (gst-print-tree (symbol-value symbol) strs)))
+
+;;;###autoload
+(defvar gst-full-error-p nil
+  "Whether to print full nodes in the output.")
+
+;;;###autoload
+(defun gst-print-tree (tree strs)
+  "Print TREE with the aid of STRS."
+  (let* ((symbol-tree (make-symbol "new-hierarchy")))
+    (set symbol-tree (hierarchy-new))
+    (maphash
+     (lambda (key value)
+       (hierarchy-add-tree
+        (symbol-value symbol-tree) key nil
+        (lambda (item)
+          (hash-table-values (car (nthcdr 4 (gethash item tree)))))))
+     tree)
+    (hierarchy-print
+     (symbol-value symbol-tree)
+     (lambda (item)
+       (cond ((= item 1) "root")
+             (t (let ((actual-str
+                       (let* ((node (gethash item tree))
+                              (leafp (eq (caddr node) 'infty))
+                              (leaf-labels
+                               (cond (leafp (car (nthcdr 5 node))))))
+                         (concat
+                          (seq-subseq
+                           (nth (car node) strs)
+                           (min (cadr node) (1- (length (nth (car node) strs))))
+                           (cond (leafp -1)
+                                 (t (caddr node))))
+                          (cond
+                           (leafp
+                            (apply
+                             #'concat
+                             (mapcar
+                              (lambda (label)
+                                (let ((first (car label))
+                                      (second (cadr label)))
+                                  (format "$ (%d : %d)"
+                                          first second)))
+                              leaf-labels))))))))
+                  (cond (gst-full-error-p
+                         (concat
+                          (format "key: %d, %s, %s" item actual-str
+                                  (gst-pretty-node (gethash item tree)))))
+                        (t actual-str)))))))))
+
+(provide 'generalized-suffix-tree)
+;;; generalized-suffiex-tree.el ends here