Programming Praxis

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