## 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<?     (append       (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)   (string-append     (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)) 1619 > (length (thirteen-anagram 200)) 9352```

We used list-of and digits from the Standard Prelude and `num->words` from a previous exercise. You can run the program at http://programmingpraxis.codepad.org/WJAZ00em.

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))))))
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))
out))))))
out))

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