bijective numeration library in Common Lisp

bijective_numeration.lisp

(defpackage #:bijective-numeration
  (:nicknames :bij)
  (:use #:common-lisp)
  (:export #:*base20-en*
           #:*base26-en*
           #:*base30-en*
           #:*base36-en*
           #:*digits*)
  (:export #:weight
           #:digit
           #:encode
           #:decode
           #:digit-sum
           #:lessp)
  (:documentation "bijective-numeration

Provides some basic functions for mapping numbers into bijective numerations"))

;;; Irritated into being by the same meme as this:
;;; http://www.flyingcoloursmaths.co.uk/attitude-really-equal-100/

;;; https://en.wikipedia.org/wiki/Bijective_numeration

(in-package #:bijective-numeration)

(defparameter *base20-en*
  "bcdfghjklmnpqrstvwxz")

(defparameter *base26-en*
  "abcdefghijklmnopqrstuvwxyz")

(defparameter *base30-en*
  "0123456789bcdfghjklmnpqrstvwxz")

(defparameter *base36-en*
  "0123456789abcdefghijklmnopqrstuvwxyz")

(defvar *digits* *base26-en*)

(defun weight (digit)
  (1+ (position digit
                *digits*
                :test #'char-equal)))

(defun digit (weight)
  (char *digits* (1- weight)))
 
(defun encode (number)
  (loop
    with d = ()
    with m = (the (integer 0) number)
    with k = (length *digits*)
    with f = (lambda (x) (1- (ceiling x)))

    for p = m then q
    until (zerop p)
    for q = (funcall f (/ m k)) then (funcall f (/ p k))
    for a = (digit (- p (* k q)))
    do (push a d)
    finally (return (concatenate 'string d))))

(defun decode (numeral)
  (loop
    with value = 0
    with radix = (length *digits*)
    for rindex = (1- (length numeral)) then (1- rindex)
    for digit across numeral
    do (incf value (* (weight digit)
                      (expt radix rindex)))
    finally (return value)))

(defun lessp (&rest numerals)
  (apply #'<
         (mapcar #'decode
                 numerals)))

(defun digit-sum (numeral)
  (reduce #'+ numeral :key #'weight))


;;;; Tests

(let ((subject ""))
  (assert (= 0
             (decode subject))))

(let ((subject 0))
  (assert (string= ""
                   (encode subject))))

(let ((subject "a"))
  (assert (= 1
             (decode subject))))

(let ((subject 1))
  (assert (string= "a"
                   (encode subject))))

(let ((subject "z"))
  (assert (= 26
             (decode subject))))

(let ((subject 26))
  (assert (string= "z"
                   (encode subject))))

(let ((subject "hardwork"))
  (assert (= 64779504723
             (decode subject)))
  (assert (= 98
             (digit-sum subject))))

(let ((subject 64779504723))
  (assert (string= "hardwork" 
                   (encode subject))))

(let ((subject "knowledge"))
  (assert (= 2414455635571
             (decode subject)))
  (assert (= 96
             (digit-sum subject))))

(let ((subject 2414455635571))
  (assert (string= "knowledge"
                   (encode subject))))

(let ((subject "attitude"))
  (assert (= 14452231825
             (decode subject)))
  (assert (= 100
             (digit-sum subject))))

(let ((subject 14452231825))
  (assert (string= "attitude" 
                   (encode subject))))

(assert (lessp "attitude" "hardwork" "knowledge"))