Skip to content

Instantly share code, notes, and snippets.

@oantolin
Created April 1, 2023 21:03
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save oantolin/867e999c3067bff2059365487b6873d2 to your computer and use it in GitHub Desktop.
Save oantolin/867e999c3067bff2059365487b6873d2 to your computer and use it in GitHub Desktop.
Component separator for orderless which makes patterns consume their match
(defun partition (pred list)
"Split LIST into elements for which PRED returns true and false."
(let (true false)
(dolist (elt list)
(if (funcall pred elt)
(push elt true)
(push elt false)))
(cons (nreverse true) (nreverse false))))
(defun connected-components (vertices adjacentp)
"Return the list of connected components of a graph.
The predicate ADJACENTP determines which pairs of VERTICES are
connected by an edge in the graph. It should be symmetric."
(cl-labels ((split-component (v vertices)
(pcase-let* ((`(,neighbors . ,others)
(partition (apply-partially adjacentp v)
vertices))
(component (list v)))
(dolist (u neighbors)
(pcase-let ((`(,comp . ,rest) (split-component u others)))
(setq component (nconc component comp)
others rest)))
(cons component others))))
(let (components)
(while vertices
(pcase-let ((`(,component . ,rest)
(split-component (car vertices) (cdr vertices))))
(push component components)
(setq vertices rest)))
components)))
(defun permutations (list)
"Return the list of all permutations of LIST."
(cl-labels ((insertions (elt list)
(if (null list)
(list (list elt))
(cons (cons elt list)
(mapcar (lambda (ins) (cons (car list) ins))
(insertions elt (cdr list))))))
(perms (list)
(if (null list)
(list nil)
(mapcan
(if (equal (car list) (cadr list))
(lambda (perm) (list (cons (car list) perm)))
(lambda (perm) (insertions (car list) perm)))
(perms (cdr list))))))
(perms
(let ((grouped (make-hash-table :test #'equal)) groups)
(dolist (elt list) (push elt (gethash elt grouped)))
(apply #'append (map-values grouped))))))
(defun consumptive-components (string)
(mapcar
(lambda (strs)
(mapconcat (lambda (perm) (string-join perm ".*"))
(permutations strs)
"\\|"))
(connected-components
(orderless-escapable-split-on-space string)
(lambda (str1 str2)
(string-match-p (regexp-opt (cl-map 'list #'string str1)) str2)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment