Phones-to-Words Challenge V: Clojure-inspired Emacs Lisp

;;; p2w.el --- Convert phone numbers to words   -*- lexical-binding: t -*-
;;
;; SPDX-FileCopyrightText: © flandrew <https://flandrew.srht.site/listful>

;;---------------------------------------------------------------------------
;; Author:    flandrew
;; Updated:   2026-04-10
;; Keywords:  lisp
;; Homepage:  <https://flandrew.srht.site/listful/software.html>
;;---------------------------------------------------------------------------
;; Package-Version:  0.2.0
;; Package-Requires: ((emacs "26.1") (xht "2") (dash "2.15") (s "1.12"))
;;---------------------------------------------------------------------------

;; SPDX-License-Identifier: GPL-3.0-or-later

;;; Commentary:
;;
;; Emacs Lisp solution to: "Convert phone numbers to words",
;;                         a programming challenge by Ron Garret.
;;
;; Original instructions: <https://flownet.com/ron/papers/lisp-java/>
;;
;; To run it, put the input and dict files in dir ./in and compile this file:
;;   (emacs-lisp-native-compile)
;;
;; Then, from a terminal:
;;   emacs --batch --load "$HOME/.emacs.d/init.el" --load p2w.elc  \
;;         --funcall p2w-xlate-phones   <in/input.txt 2>/dev/null
;; or:
;;   emacs --batch --load "$HOME/.emacs.d/init.el" --load p2w.elc  \
;;         --eval '(p2w-xlate-phones (h* :dict "in/sample-dict"))' \
;;         <in/sample-input 2>/dev/null
;;
;; The above assumes that init.el sets load paths for xht, dash, and s.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; Code:
;;;; Libraries

(require 'xht)  ; by the same author   (dash and s are transitively required)


;;;; Functions
;;;;; Make translation trees

(defun p2w--split (s c)
  "Split a string S in two at C characters from the left."
  (list (substring s 0 c) (substring s c (length s))))

(defun p2w--xlate-deep (s m ok-digit)
  "Return tree of all licit translations of string S and its substrings.
M is a digits-string->matching-words map.
Through OK-DIGIT, keep track of whether it'd be ok to use a digit."
  (->> (list () () (length s))
       (-fix (-lambda ((res hits sub))
               (if (zerop sub)
                   (list res hits sub)
                 (-let* (((s1 s2) (p2w--split s sub))
                         ((x1 ok) (--> (h-get m s1)  (-list it)
                                       (if (and (= sub 1) (null it)
                                                ok-digit  (null hits))
                                           `((,s1) nil)
                                         `(,it t))))
                         (new-res (when x1
                                    (if (s-blank? s2)
                                        `(,x1)
                                      (let ((xa2 (p2w--xlate-deep s2 m ok)))
                                        (when xa2
                                          `(,x1 ,@xa2)))))))
                   (list (if new-res (cons new-res res) res)
                         (append hits x1)
                         (1- sub))))))
       car  nreverse))

(defun p2w--paths (tree)
  "All root-to-leaf paths of a translation TREE."
  (-mapcat (-lambda ((b . bs))
             (-table-flat (lambda (b n) `(,b ,@n))
                          b (if bs (p2w--paths bs) `(,bs))))
           tree))


;;;;; Build dictionary

(defun p2w--only-lower (s) (s-replace-regexp "[^a-z]" "" s))

(defun p2w--word->num (word a2d)
  "Translate WORD to numeric string using alphas-to-digits map A2D."
  (->> word  downcase  p2w--only-lower  string-to-list
       (--map (h-get a2d it))  concat))

(defun p2w--dict->num-words (dict a2d)
  "Convert a DICT string into a map of numeric-string to dict-words.
Use A2D — an alpha-to-digits conversion map."
  (let* ((words (s-lines (s-trim dict)))
         (res (h-new (length words))))
    (while-let ((word (pop words)))
      (h-put-add! res (p2w--word->num word a2d) word))
    res))

(defun p2w--as->ds (alphas digits)
  "Create mapping from lowercase ALPHAS to DIGITS."
  (h-zip-lists (string-to-list alphas)
               (string-to-list digits)))


;;;;; Make final strings

(defun p2w--only-digit (s) (s-replace-regexp "[^0-9]" "" s))

(defun p2w--xlation-lines-1 (s m)
  "String of translation line(s) for a given phone S.
M is a digits-string->matching-words map."
  (->> (p2w--xlate-deep (p2w--only-digit s) m t)  p2w--paths
       (--map (format "%s: %s\n" s (s-join " " it)))
       (s-join "")))

(defun p2w--slurp (file)
  "Read the contents of FILE."
  (with-temp-buffer (insert-file-contents file) (buffer-string)))

(defun p2w--read-line ()
  "Read a line from stream."
  (ignore-errors (read-from-minibuffer "")))

(defun p2w-xlate-phones (&optional htbl)
  "Print translations for lines of phones.
Optional argument HTBL is a hash table with values for dictionary file
and alphas-to-digits translation. If nil, use defaults."
  (h-let (h-mix (h* :alphas "ejnqrwxdsyftamcivbkulopghz"
                    :digits "01112223334455666777888999"
                    :dict   "in/dictionary.txt")
                (or htbl (h*)))
    (let* ((a2d (p2w--as->ds .alphas .digits))
           (map (p2w--dict->num-words (p2w--slurp .dict) a2d)))
      (while-let ((phone (p2w--read-line)))
        (princ (p2w--xlation-lines-1 phone map))))))


;;;; Wrapping up

(provide 'p2w)

;; Local Variables:
;; coding:                     utf-8
;; indent-tabs-mode:           nil
;; sentence-end-double-space:  nil
;; outline-regexp:             ";;;;* "
;; End:

;;; p2w.el ends here