2019-01-20 05:38:02 +00:00
|
|
|
;;; anagram.el --- Anagram (exercism)
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
(provide 'anagram)
|
|
|
|
|
|
2019-02-05 02:27:15 +00:00
|
|
|
(defun get-char-count (w)
|
2019-01-20 19:37:55 +00:00
|
|
|
"Return an associative list of character counts for W."
|
2019-02-05 02:27:15 +00:00
|
|
|
(let ((char-list (string-to-list w))
|
2019-01-20 19:37:55 +00:00
|
|
|
(char-count ()))
|
2019-01-20 05:38:02 +00:00
|
|
|
;; Build an associative list from the character list.
|
2019-01-20 19:37:55 +00:00
|
|
|
(dolist (char char-list char-count)
|
2019-02-05 02:27:15 +00:00
|
|
|
(let ((entry (assoc char char-count)))
|
|
|
|
|
(if entry (cl-incf (cdr entry))
|
|
|
|
|
(push (cons char 1) char-count))))))
|
2019-01-20 05:38:02 +00:00
|
|
|
|
2019-02-05 02:28:37 +00:00
|
|
|
(defun equal-char-count (char-count comparison-char-count)
|
2019-01-20 19:38:17 +00:00
|
|
|
"Return t if the submitted character counts are equal, false otherwise.
|
|
|
|
|
CHAR-COUNT and COMPARISON-CHAR-COUNT should be alists in (character . count) format."
|
2019-01-20 05:38:02 +00:00
|
|
|
(let ((are-equal t))
|
2019-01-20 19:38:17 +00:00
|
|
|
(dolist (char-count char-count are-equal)
|
2019-01-20 05:38:02 +00:00
|
|
|
(if (not are-equal) nil)
|
2019-01-20 19:38:17 +00:00
|
|
|
(if (assoc (car char-count) comparison-char-count)
|
2019-01-20 05:38:02 +00:00
|
|
|
(if (not (equal
|
|
|
|
|
(cdr char-count)
|
2019-01-20 19:38:17 +00:00
|
|
|
(cdr (assoc (car char-count) comparison-char-count))))
|
2019-01-20 05:38:02 +00:00
|
|
|
(setq are-equal nil))
|
|
|
|
|
(setq are-equal nil)))))
|
|
|
|
|
|
|
|
|
|
(defun anagrams-for(word anagrams)
|
2019-01-20 19:38:32 +00:00
|
|
|
"Return all elements of ANAGRAMS which are anagrams for WORD.
|
|
|
|
|
Case insensitive."
|
2019-01-20 05:38:02 +00:00
|
|
|
(let ((candidates ())
|
2019-01-20 19:38:32 +00:00
|
|
|
(word-char-count (get-char-count (downcase word))))
|
2019-01-20 05:38:02 +00:00
|
|
|
(dolist (candidate anagrams candidates)
|
|
|
|
|
(if (and
|
|
|
|
|
(not (string-equal word candidate))
|
|
|
|
|
(equal (length word) (length candidate))
|
2019-01-20 19:38:32 +00:00
|
|
|
(equal-char-count word-char-count (get-char-count (downcase candidate))))
|
2019-01-20 05:38:02 +00:00
|
|
|
(if (> (length candidates) 0)
|
|
|
|
|
(add-to-list 'candidates candidate t)
|
|
|
|
|
(setq candidates (cons candidate nil)))))))
|
|
|
|
|
|
|
|
|
|
;;; anagram.el ends here
|