Counting Words III: Many solutions in Emacs Lisp

(require 'dash)
(require 'ht)
(require 'f)
(require 's)

(defun cw-sort-alist (alist)
  "Reverse-numerically sort cdr of ALIST, then convert it to a single string."
  (->> alist
       (--sort (string< (car it) (car other))) ; alphabetic when same number
       (--sort (>       (cdr it) (cdr other)))
       (--map  (concat  (car it) " " (format "%d" (cdr it))))
       (s-join   "\n")
       (s-append "\n")))

'(("the"    . 2)
  ("foozle" . 1)
  ("bar"    . 5)
  ("foo"    . 2))

(defun cw-split-words (str)
  "Split STR into list of words."
  (s-split "[^[:alpha:]]+" str t))

M-x profiler-start
(cw-count-it-3 "in/kjv÷10.txt")
M-x profiler-report

(defun cw-count-it-6 (file)
  "Given a FILE, count words."
  (let ((words (ht-create)))
    (with-temp-buffer
      (insert-file-contents file)
      (while (search-forward-regexp "\\b[[:alpha:]]+\\b" nil t)
        (--> (match-string 0)  downcase
             (ht-set! words it
                      (1+ (or (ht-get words it) 0))))))
    (->> words  ht->alist  cw-sort-alist)))

(defun cw-count-it-7 (file)
  "Given a FILE, count words."
  (let* ((words   (ht-create))
         (addword (lambda (word)
                    (ht-set! words word (1+ (or (ht-get words word) 0)))))
         (string  (->> file  f-read  downcase))
         (length  (length string))
         ;; Initialize variables
         (pos     length)
         (word    "")
         letter)
    (while (> pos 0)
      (setq letter (substring string (1- pos) pos))
      (pcase (string-match "[[:alpha:]]" letter)
        (0 (setq word (concat letter word)))
        (_ (funcall addword word)
           (setq word "")))
      (setq pos (1- pos)))
    (funcall addword word)
    (ht-remove! words "")
    (->> words  ht->alist  cw-sort-alist)))

(defun cw-count-it-8 (file)
  "Given a FILE, count words."
  (let* ((words   (ht-create))
         (addword (lambda (charlist)
                    (let ((word (concat charlist)))
                      (ht-set! words word (1+ (or (ht-get words word) 0))))))
         (string  (->> file  f-read  downcase))
         (length  (length string))
         ;; Initialize variables
         (pos     length)
         word char)
    (while (> pos 0)
      (setq char (aref string (1- pos)))
      (if (and (>= char ?a)
               (<= char ?z))
          (setq word (cons char word))
        (funcall addword word)
        (setq word nil))
      (setq pos (1- pos)))
    (funcall addword word)
    (ht-remove! words "")
    (->> words  ht->alist  cw-sort-alist)))

(let* ((file       "!/path/to/countwords/in/kjv.txt")
       (string     (f-read file))
       (len        (length string))
       (aref-time  (->> (dotimes (i len) (aref      string i))
                     benchmark-elapse (format "%.3f") read))
       (subs-time  (->> (dotimes (i len) (substring string i (1+ i)))
                     benchmark-elapse (format "%.3f") read)))
  `(( aref       substring)   hline
    (,aref-time ,subs-time)))

(defun cw-count-it-9 (file)
  "Given a FILE, count words."
  (with-temp-buffer
    (insert-file-contents file)
    (goto-char (point-min))
    (while (re-search-forward "[^[:alpha:]]+" nil t)
      (replace-match "\n"))
    (downcase-region (point-min) (point-max))
    (sort-lines t    (point-min) (point-max))
    (goto-char (point-max))
    (while (bolp)
      (delete-char -1))
    (insert "\n")
    (goto-char (point-min))
    (let ((start (point))
          (ct    1))
      (while (not (eobp))
        (pcase (looking-at "\\(.*\n\\)\\1")
          ('t   (forward-line)
                (setq ct (1+ ct)))
          ('nil (delete-region start (point))
                (end-of-line)
                (insert " " (number-to-string ct))
                (forward-char)
                (setq start (point)
                      ct    1)))))
    (sort-numeric-fields 2 (point-min) (point-max))
    (reverse-region        (point-min) (point-max))
    (buffer-string)))

(defun cw-count-it-10 (file)
  "Given a FILE, count words."
  (with-temp-buffer
    (let* ((sorted (--> file  f-read  downcase  cw-split-words  vconcat
                        (sort it #'string>)))
           (idx    0)
           (max    (1- (length sorted)))
           (pre    (aref sorted idx))
           (ct     1)
           alist cur)
      (while (< idx max)
        (setq idx (1+ idx)
              cur (aref sorted idx))
        (if (equal pre cur)
            (setq ct (1+ ct))
          (push (cons pre ct) alist)
          (setq pre cur
                ct  1)))
      (push (cons pre ct) alist)
      (cw-sort-alist alist))))

(defun cw-count-it-11 (file)
  "Given a FILE, count words."
  (with-temp-buffer
    (let* ((sorted (--> file  f-read  downcase  cw-split-words  vconcat
                        (sort it #'string>)))
           (idx    0)
           (max    (1- (length sorted)))
           (pre    (aref sorted idx))
           (ct     1)
           (words  (ht-create))
           cur)
      (while (< idx max)
        (setq idx (1+ idx)
              cur (aref sorted idx))
        (if (equal pre cur)
            (setq ct (1+ ct))
          (ht-set! words pre ct)
          (setq pre cur
                ct  1)))
      (ht-set! words pre ct)
      (->> words  ht->alist  cw-sort-alist))))

;;; cw-constrained.el --- Observe all the original constraints  -*- lexical-binding: t -*-

;;; Commentary:
;; Observe all the constraints given by the original exercise.

;;; Code:

(defun cw-main ()
  "Print results of ‘cw-process-stream’ to stdout."
  (princ (cw-process-stream)))

(defun cw-process-stream ()
  "Given a stream, return sorted word-count pair."
  (let ((words (make-hash-table :test 'equal)))
    (cw-read-and-process-lines (lambda (str) (cw-process-line words str)))
    (cw-ht->sorted-alist words)))

(defun cw-read-and-process-lines (fun)
  "Given a stream, process each line with function FUN."
  (let (line)
    (while (setq line (ignore-errors (read-from-minibuffer "")))
      (funcall fun line))))

(defun cw-process-line (table str)
  "Update counter of hashtable TABLE for each word of string STR."
  (mapc (lambda (word)
          (unless (string= word "")
            (prog1 nil
              (puthash (downcase word)
                       (1+ (or (gethash (downcase word) table)
                               0))
                       table))))
        (split-string str "[ \n]+")))

(defun cw-ht->sorted-alist (table)
  "Convert hash-table TABLE to an alist, then to a sorted string.
The cdr of the alist is reverse-numerically sorted, then converted to a single string."
  (let (res)
    (maphash (lambda (key value)
               (push (cons key value) res))
             table)
    (setq res (sort res (lambda (it other) (string< (car it) (car other)))))
    (setq res (sort res (lambda (it other) (>       (cdr it) (cdr other)))))
    (format "%s\n" (mapconcat 'identity
                              (mapcar (lambda (it)
                                        (concat  (car it) " "
                                                 (format "%d" (cdr it))))
                                      res)
                              "\n"))))

(cw-main)
(kill-emacs 0)

;;; cw-constrained.el ends here

(defun cw-count-it-A (file)
  "Given a FILE, count words."
  (shell-command-to-string
   (format "<%s  emacs --quick --script %s/%s  2>/dev/null"
           file default-directory "cw-constrained.elc")))

(cd ./in && ln -nfs kjv{×,bible_x}10.txt)     # the exercise's original filename
ln -nfs cw-constrained.el   cw-count-it-A.el  # a symlink
ln -nfs cw-constrained.elc  cw-count-it-A.elc # a symlink
time emacs --quick --script cw-count-it-A.elc < in/kjvbible_x10.txt >/dev/null

(defun cw-count-it-B (file)
  "Given a FILE, count words."
  (let ((words (ht-create)))
    (->> file  f-read  downcase  (s-split "[ \n\r\t\v\f]+")
         (mapc (lambda (word)
                 (ht-set! words word (1+ (or (ht-get words word) 0))))))
    (ht-remove! words "")
    (->> words  ht->alist  cw-sort-alist)))

#!/usr/bin/env bash

# SPDX-FileCopyrightText:  © 2021 Ben Hoyt
# SPDX-FileCopyrightText:  © flandrew
#
# SPDX-License-Identifier: MIT
#
#
# Benchmark for Ben Hoyt's count-words exercise.
#
#   Modified by me from Ben Hoyt's version:
#   - it has only a few languages
#   - it includes my solutions
#   - some extra auxiliary functions, plus much alignment
#
#   For context and background, see his full article and repo here:
#      <https://benhoyt.com/writings/count-words/>
#      <https://github.com/benhoyt/countwords/>

#------------------------------------------------------------------------------

## Variables
k10="kjvbible_x10.txt"
out="output.txt"

## Functions
normalize()  { python3 normalize.py >"$out" ;}       # Piped to
awkp-norm()  { awk '{ print $2, $1 }' | normalize ;} # Piped to

#------------------------------------------------------------------------------

## Main

cat kjvbible.txt{,,,,,,,,,} >"$k10"

# AWK
echo AWK simple                   ; gawk -f     simple.awk <"$k10" | normalize
if command -v mawk > /dev/null; then
    echo AWK optimized            ; mawk -f  optimized.awk <"$k10" | normalize
fi

# C, C++
echo C simple    ; gcc -O2 "$_".c   -o "$_"-c   ; ./"$_"   <"$k10" | normalize
echo C optimized ; gcc -O2 "$_".c   -o "$_"-c   ; ./"$_"   <"$k10" | normalize
echo C++ simple  ; g++ -O2 "$_".cpp -o "$_"-cpp ; ./"$_"   <"$k10" | normalize

# Other
echo Perl simple                  ; perl         simple.pl <"$k10" | normalize
echo Python simple                ; python3      simple.py <"$k10" | normalize
echo Python optimized             ; python3   optimized.py <"$k10" | normalize
echo Ruby simple                  ; ruby         simple.rb <"$k10" | normalize
echo Unix shell simple            ; bash         simple.sh <"$k10" | awkp-norm
echo Unix shell optimized         ; bash      optimized.sh <"$k10" | awkp-norm

# These have been normalized already (MD5-verified)
echo Unix shell — mine            ; bash     countwords.sh <"$k10"
echo Emacs Lisp — simple — mine   ; bash cw-constrained.sh <"$k10"
echo Emacs Lisp — optimized — mine; bash      cw-byline.sh <"$k10"

#!/usr/bin/env python3
#
# SPDX-FileCopyrightText:  © 2021 Ben Hoyt
# SPDX-FileCopyrightText:  © flandrew
#
# SPDX-License-Identifier: MIT
#
#
# Benchmark for Ben Hoyt's count-words exercise.
#
#   Modified by me from Ben Hoyt's version, so that:
#   - it has only a few languages
#   - it includes my solutions
#   - the output goes to an Org table
#
#   For context and background, see his full article and repo here:
#      <https://benhoyt.com/writings/count-words/>
#      <https://github.com/benhoyt/countwords/>

# Benchmark different versions and output results as Table
# NOTE: run after ./test.sh (which compiles the binaries)

import subprocess
import time

NUM_RUNS = 5
INPUT_FILENAME = 'kjvbible_x10.txt'

def time_run(cmdline):
    cmdline = cmdline + ' <{} >/dev/null'.format(INPUT_FILENAME)
    times = []
    for _ in range(NUM_RUNS):
        start = time.time()
        subprocess.run(cmdline, shell=True)
        elapsed = time.time() - start
        times.append(elapsed)
    return min(times)

programs = [
    ('Emacs Lisp',
     'emacs --quick --script cw-count-it-A.elc',
     'emacs --quick --script cw-count-it-B.elc',    'by me <-----'),
    ('Shell',  'bash countwords.sh',  None,         'by me <-----'),
    ('Shell',  'bash simple.sh',     'bash optimized.sh', ''),
    ('C',      './simple-c',         './optimized-c', ''),
    ('C++',    './simple-cpp',        None, ''),
    ('Perl',   'perl simple.pl',      None, 'by Charles Randall'),
    ('Python', 'python3 simple.py',  'python3 optimized.py', ''),
    ('Ruby',   'ruby simple.rb',      None, ''),
    ('AWK',    'gawk -f simple.awk', 'mawk -f optimized.awk',
     'optimized uses `mawk`'),
    ('grep',   'grep foobar', 'LC_ALL=C grep foobar', '`grep` baseline'),
    ('wc -w',  'wc -w',       'LC_ALL=C wc -w',       '`wc` baseline'),
]

times = []
for program in programs:
    lang, simple, optimized, _ = program
    print('Timing', lang, end=' ', flush=True)
    simple_time = time_run(simple)
    optimized_time = time_run(optimized) if optimized else None
    print('{:.2f} {:.2f}'.format(simple_time, optimized_time or 0))
    times.append((program, simple_time, optimized_time))
times.sort(key=lambda x: x[1])  # sort by simple_time

print()
print('| Language      | Simple | Optimized | Notes |')
print('|---------------+--------+-----------+-------|')
for program, simple_time, optimized_time in times:
    lang, _, _, notes = program
    if optimized_time is not None:
        print('| {:13} | {:6.2f} | {:9.2f} | {} |'.format(lang, simple_time, optimized_time, notes))
    else:
        print('| {:13} | {:6.2f} | {:9} | {} |'.format(lang, simple_time, '', notes))

;;; cw-count-it-B.el --- Changing the split -*- lexical-binding: t -*-

;;; Commentary:
;; This one changes the definition of word.

;;; Code:
(defun cw-load-paths-and-requires ()
  "Load paths and requires."
  (let ((default-directory  "~/.emacs.d/lisp"))
    (normal-top-level-add-to-load-path '("."))
    (normal-top-level-add-subdirs-to-load-path)
    (add-to-list 'load-path default-directory)
    (add-to-list 'load-path "~/path/to/countwords/"))
  (require 'countwords))

(cw-load-paths-and-requires)
(f-write (cw-count-it-B "kjvbible_x10.txt")
         'utf-8
         "cw-count-it-B--out.txt")
(kill-emacs 0)

;;; cw-count-it-B.el ends here