Thirteen Anagram

January 10, 2012

We follow a prep-sort-merge strategy. The preparation stage involves creating lists of symbols and letters for an arithmetic expression. Thus, (symbols #\+ 12 1) returns the list (#\+ #\1 #\1 #\2) and (words #\+ 12 1) returns the list (#\+ #\e #\e#\e #\l #\l #\n #\o #\p #\s #\t #\u #\v #\w):

(define (symbols op x y)
  (sort char<?
      (list (case op ((+) #\+) ((-) #\-) ((*) #\*) ((/) #\/)))
      (map (lambda (n) (integer->char (+ n 48))) (digits x))
      (map (lambda (n) (integer->char (+ n 48))) (digits y)))))

(define (words op x y)
  (define (w n)
    (filter char-alphabetic?
      (string->list (num->words n))))
  (sort char<? (append (w x) (w y)
    (string->list (case op ((+) "plus")
      ((-) "minus") ((*) "times") ((/) "divide"))))))

For the sort stage, we will need to compare two lists in order by their constituent characters:

(define (list< xs ys)
  (let loop ((xs xs) (ys ys))
    (cond ((null? xs) (pair? ys))
          ((null? ys) (pair? xs))
          ((char<? (car xs) (car ys)) #t)
          ((char<? (car ys) (car xs)) #f)
          (else (loop (cdr xs) (cdr ys))))))

Make-xs generates all combinations of operators in the list {+ − × ÷} with two operands in the range 1 .. n inclusive and builds a list of four-slot lists: the first slot has the result of the operation, the second slot has the expression in normal Scheme form as a list (op x y), the third slot has the list of symbols, and the fourth slot has the list of letters:

(define (make-xs n)
  (sort (lambda (a b)
          (cond ((< (car a) (car b)) #t)
                ((< (car b) (car a)) #f)
                ((list< (caddr a) (caddr b)) #t)
                ((list< (caddr b) (caddr a)) #f)
                ((list< (cadddr a) (cadddr b)) #t)
                ((list< (cadddr b) (cadddr a)) #f)
                (else #f)))
    (list-of (list (eval (list op x y)) (list op x y)
                   (symbols op x y) (words op x y))
      (op in '(+ - * /)) (x range 1 (+ n 1)) (y range 1 (+ n 1)))))

The main function executes the prep-sort-merge strategy. Xs collects the four-slot lists built by make-xs, sorted in order by result, and compares adjacent items; those with identical results, symbol-lists and letter-lists are passed to the output. Then alt strips one of each adjacent pair, which are identical, and format-anagram creates pretty output:

(define (thirteen-anagram n)
  (let loop ((xs (make-xs n)) (zs (list)))
    (if (null? (cdr xs))
        (map format-anagram (alt zs))
        (let ((x0 (car xs)) (x1 (cadr xs)))
          (cond ((not (= (car x0) (car x1)))
                  (loop (cdr xs) zs)) ; different result
                ((not (equal? (caddr x0) (caddr x1)))
                  (loop (cdr xs) zs)) ; different symbols
                ((not (equal? (cadddr x0) (cadddr x1)))
                  (loop (cdr xs) zs)) ; different words
                ((and (= (list-ref (cadr x0) 1) (list-ref (cadr x1) 2))
                      (= (list-ref (cadr x0) 2) (list-ref (cadr x1) 1)))
                  (loop (cdr xs) zs)) ; same operands different order
                (else (loop (cdr xs) (cons (list x0 x1) zs))))))))

Here are the two helpers alt and format-anagram:

(define (alt xs)
  (let loop ((xs xs) (zs (list)))
    (if (null? xs) zs
      (loop (cddr xs) (cons (car xs) zs)))))

(define (format-anagram xs)
    (number->string (list-ref (cadar xs) 1))
    (symbol->string (list-ref (cadar xs) 0))
    (number->string (list-ref (cadar xs) 2))
    (number->string (list-ref (cadadr xs) 1))
    (symbol->string (list-ref (cadadr xs) 0))
    (number->string (list-ref (cadadr xs) 2))))

Some examples are shown below. Tyson’s 12+1=11+2 result is the smallest example of many.

> (thirteen-anagram 20)
("11+2=12+1" "14+6=16+4" "14+7=17+4" "14+9=19+4" "16+7=17+6"
"16+9=19+6" "17+9=19+7")
> (length (thirteen-anagram 100))
> (length (thirteen-anagram 200))

We used list-of and digits from the Standard Prelude and num->words from a previous exercise. You can run the program at


Pages: 1 2

One Response to “Thirteen Anagram”

  1. mitchell perilstein said

    Here’s a little Emacs Lisp solution that handles the minimal case as posed. Minimal, because as you get larger, and use the operators more as in the moderator’s more general example, you’ll find more hits. As explorer, you will need to decide if you will accept negative subtraction results and nonzero division results. Does this work in any non-English languages?

    (defconst GENMAX 13)
    (defconst OPWORDS ‘((+ plus) (- minus) (* times) (/ divide)))
    (defconst NUMWORDS ‘(zero one two three four five six seven eight nine ten eleven twelve thirteen ))

    (defun math-words-equal (a b)
    (equal (sorted-explode (equation-to-mathwords a))
    (sorted-explode (equation-to-mathwords b))))

    (defun numword (n) (symbol-name (nth n NUMWORDS)))
    (defun opword (o) (symbol-name (cadr (assoc o OPWORDS))))
    (defun sorted-explode (str) (sort (coerce str ‘list) ‘<))

    (defun equation-to-mathwords (e)
    (concat (numword (cadr e)) " " (opword (car e)) " " (numword (caddr e))))

    (defun equations-equal (x y)
    (and (not (equal x y))
    (equal (eval x) (eval y))
    (math-words-equal x y)))

    (defun generate-equations () ;; ((- 5 5) (+ 5 5) (- 5 4) ….
    (let ((e nil)
    (ops (mapcar 'car OPWORDS)))
    (loop for i from 1 to GENMAX do
    (loop for j from 1 to i do
    (loop for op in ops do
    (if (not (and (equal op '-) (equal i j))) ;;; no 0's please
    (setq e (cons (list op i j) e))))))

    (defun thirteen ()
    (let ((all (generate-equations))
    (out nil))
    (loop for i from 1 to (length all) do
    (loop for j from 1 to i do
    (let ((a (nth i all))
    (b (nth j all)))
    (if (equations-equal a b)
    (setq out (cons (list
    a (equation-to-mathwords a)
    b (equation-to-mathwords b))

    ;; (thirteen)
    ;; (((+ 11 2) "eleven plus two" (+ 12 1) "twelve plus one"))

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: