Duval's Algorithm

Duval's Algorithm computes a factorization of a word w 𝑤 w into a series of Lyndon Words w i subscript 𝑤 𝑖 w_{i} with the property that w 1 ≥ w 2 ≥ ⋯ ⁢ w k subscript 𝑤 1 subscript 𝑤 2 ⋯ subscript 𝑤 𝑘 w_{1}\geq w_{2}\geq\cdots w_{k} .

(defun lyndon-factors (str)
  "Compute the Lyndon factorization of STR."
  (let ((i 0)
        (s 0)
        (e 1)
        factors)
    (while (< i (length str))
      (setq s i)
      (setq e (+ i 1))
      (while (and (< e (length str)) (<= (elt str s) (elt str e)))
        (if (< (elt str s) (elt str e))
            (setq s i)
          (setq s (+ s 1)))
        (setq e (+ e 1)))
      (while (<= i s)
        (push (substring str i (+ i (- e s))) factors)
        (setq i (+ i (- e s)))))
    (nreverse factors)))

(lyndon-factors "abaababaabaaba")
(require 're-builder)

(defvar lyndon-mode-overlays nil
  "List of overlays used by `lyndon-mode'.")

(defun lyndon-mode-delete-overlays ()
  "Delete all `lyndon-mode' overlays in the current buffer."
  (mapc 'delete-overlay lyndon-mode-overlays)
  (setq lyndon-mode-overlays nil))

(defun lyndon-mode-update-overlays ()
  "Compute the Lyndon factorization of the current buffer, and update overlays."
  (interactive)
  (lyndon-mode-delete-overlays)
  (save-excursion
      (goto-char (point-min))
      (let ((nface 0)
        s e)
    (while (not (eobp))
      (setq s (point))
      (setq e (1+ (point)))
      (while (and (< e (point-max)) (<= (char-after s) (char-after e)))
        (if (< (char-after s) (char-after e))
        (setq s (point))
          (setq s (1+ s)))
        (setq e (1+ e)))
      (while (<= (point) s)
        (let ((overlay (make-overlay (point) (+ (point) (- e s))))
          (face (intern (format "reb-match-%d" nface))))
          (overlay-put overlay 'face face)
          (push overlay lyndon-mode-overlays)
          (setq nface (mod (1+ nface) 4))
          (forward-char (- e s))))))))

(defun lyndon-mode-after-change (_start _end _len)
  "Shim `lyndon-mode-update-overlays' for `after-change-functions'."
  (lyndon-mode-update-overlays))

;;;###autoload
(define-minor-mode lyndon-mode
  "Display the lyndon factorization of the current buffer."
  :lighter "Lyndon"
  (if lyndon-mode
      (progn
    (add-hook 'after-change-functions #'lyndon-mode-after-change nil t)
    (lyndon-mode-update-overlays))
    (lyndon-mode-delete-overlays)
    (remove-hook 'after-change-functions #'lyndon-mode-after-change t)))

References