Tell me more ×
Code Review Stack Exchange is a question and answer site for peer programmer code reviews. It's 100% free, no registration required.
up vote 3 down vote favorite

This code is intended to find all possible solutions to a cryptoarithmetic problem. The description of the problem I was trying to solve is here:

;;Cryptoarithmetic. In cryptoarithmetic problems, we are given a problem wherein the digits are replaced
;;with characters representing digits. A solution to such a problem is a set of digits that, when substituted
;;in the problem, gives a true numerical interpretation. Example:
;;   IS
;;   IT
;;   ___
;;   OK
;;
;;   Has a solution { I = 1; K = 1; O = 3; S = 5; T = 6}.  For each of the below cryptoarithmetic problems,
;;   write a program that finds all the solutions in the shortest possible time.
;;
;;   IS     I
;;   IT    AM
;;   __    __
;;   OK    OK

I was only able to solve it using brute force, though I believe there are more efficient methods. I am also hoping to receive feedback on my formatting, naming, and really anything you think could use improvement. If you have any comments on my code, I would be very grateful. Thanks for looking!

(defun place-value-to-integer (the-list &OPTIONAL place-value) 
  (let ((place-value (if place-value place-value 1))) 
    (if (= (length the-list) 1) (* place-value (first the-list))
      (+ (* place-value (first (last the-list))) (place-value-to-integer (butlast the-list) (* 10 place-value))))))

(defun fill-from-formula (formula guess)
  (loop for digit in formula collect (gethash digit guess)))

(defun check-answer (augend-formula addend-formula sum-formula guess)
  (let ((augend (fill-from-formula augend-formula guess))
    (addend (fill-from-formula addend-formula guess))
    (sum (fill-from-formula sum-formula guess)))
        (= (place-value-to-integer sum) (+ (place-value-to-integer augend) (place-value-to-integer addend)))))

(defun brute-force-guess(augend-formula addend-formula sum-formula unique-values &OPTIONAL callback guess) 
  (let ((guess (if (null guess) (make-hash-table) guess)))
    (loop for digit in '(0 1 2 3 4 5 6 7 8 9) do 
      (setf (gethash (car unique-values) guess) digit) 
      (if (= (length unique-values) 1) 
        (if (check-answer augend-formula addend-formula sum-formula guess) (print-result augend-formula addend-formula sum-formula guess) nil)
        (brute-force-guess augend-formula addend-formula sum-formula (cdr unique-values) callback guess)))))

(defun print-result (augend-formula addend-formula sum-formula guess) 
  (format t "One answer is ~a + ~a = ~a ~%" 
      (fill-from-formula augend-formula guess)
      (fill-from-formula addend-formula guess)
      (fill-from-formula sum-formula guess)))

(defun find-unique-values (the-list) 
  (let ((unique-items ())) 
    (loop for sublist in the-list do 
      (loop for item in sublist do
          (unless (member item unique-items) (setf unique-items (append (list item) unique-items))))) unique-items))

(let ((problemA (list (list 'I 'S) (list 'I 'T) (list 'O 'K)))
      (problemB (list (list 'I) (list 'A 'M) (list 'O 'K))))
    (brute-force-guess (first problemA) (second problemA) (third problemA) (find-unique-values problemA) #'print-result)
    (brute-force-guess (first problemB) (second problemB) (third problemB) (find-unique-values problemB) #'print-result))
share|improve this question

1 Answer

up vote 2 down vote accepted

Some preliminary notes for now (I'll add later):

Whenever you need to write (if n n 2) or (if (not n) 2 n), you can instead write (or n 2). or will take any number of arguments and return either nil or the first argument that evaluates to non-nil.

When working with optional arguments, you can set defaults for them. 

(defun place-value-to-integer (the-list &OPTIONAL place-value) 
  (let ((place-value (if place-value place-value 1)))
  ...

can be written as

(defun place-value-to-integer (the-list &OPTIONAL (place-value 1)) 
  ...

I don't have time to get into the rest right now, but you're using loop to setf a series of hash values, which tells me you could probably simplify it by using a more functional approach (it might be one of the exceptions, but it doesn't feel like one at first glance).

EDIT:

(if a b nil) is equivalent to (when a b) (and it's good style to use the second over the first).

EDIT2: Ok, wow, hey. That's two hours of my life I won't get back. I wrote up and edited down a pretty ridiculously long piece on my process (if you care, it's here). Here's how I would tackle a brute-force approach to this problem.

EDIT3: Simplified slightly.

(defpackage :cry-fun (:use :cl :cl-ppcre))
(in-package :cry-fun)

(defun digits->number! (&rest digits)
  (apply #'+ (loop for d in (nreverse digits) for i from 0
                   collect (* d (expt 10 i)))))

(defun number->digits (num &optional (pad-to 5))
  (let ((temp num)
        (digits nil))
     (loop do (multiple-value-call 
                   (lambda (rest d) (setf temp rest digits (cons d digits)))
                (floor temp 10))
           until (= pad-to (length digits)))
     digits))

(defun string->terms (problem-string)
  (reverse
   (mapcar (lambda (s) (mapcar (lambda (i) (intern (format nil "~a" i))) 
                   (coerce s 'list)))
           (split " " (string-downcase problem-string)))))

(defmacro solve-for (problem-string)
  (let* ((arg-count (length (remove-duplicates (regex-replace-all " " problem-string ""))))
         (nines (apply #'digits->number! (make-list arg-count :initial-element 9))))
    `(loop for i from 0 to ,nines
           when (apply (solution-fn ,problem-string) (number->digits i ,arg-count))
           collect it)))

(defmacro solution-fn (problem-string)
  (let* ((terms (string->terms problem-string))
         (args (remove-duplicates (apply #'append terms))))
    `(lambda ,args
       (when (= (+ ,@(loop for term in (cdr terms) collect `(digits->number! ,@term)))
                (digits->number! ,@(car terms)))
             (list ,@(mapcan (lambda (i) (list (symbol-name i) i)) args))))))

EDIT (by jaresty): adding comments to show example intermediate values for "solution-fn" 

(defmacro solution-fn (problem-string)
  (let* ((terms (string->terms problem-string)) 
     ;example: (terms ((o k) (i t) (i s)))
         (args (remove-duplicates (apply #'append terms)))) 
         ;example: (args (o k t i s))
    `(lambda ,args
       (when (= (+ ,@(loop for term in (cdr terms) collect `(digits->number! ,@term)))  
                (digits->number! ,@(car terms)))
        ;example: (when (= (+ (i t) (i s)) (o k)
             (list ,@(mapcan (lambda (i) (list (symbol-name i) i)) args))))))
        ;example: (list "o" o "k" k "t" t "i" i "s" s)
share|improve this answer
Wow, this is a pretty intense solution! I'm going to need to study it for a while to try and understand how it works. Thanks for the feedback! – jaresty Mar 12 '11 at 8:42
Can you explain what multiple-value-call does in number->digits? I'm having some trouble understanding how it works. – jaresty Mar 12 '11 at 10:37
1  
@jaresty: floor returns two values: the floored value and the remainder. However when calling it normally, only the first return value will be used. By using multiple-value-call both values returned by floor are given to the lambda. – sepp2k♦ Mar 12 '11 at 13:00
1  
I linked to a blog post in which I go step-by-step on how I came up with this (it's actually a lot simpler than it looks; most of the complexity in it is introduced because the naive solution I started with performed quite poorly, and the question specifies "as fast as possible"). sepp2k got it on the multiple-value-call, and yeah -> is just part of a name. It's a convention from Scheme where foo->bar lets you know that the function takes a foo and returns a bar. – Inaimathi Mar 12 '11 at 13:55
Why do you need to use defmacro rather than defun for solve-for and solution-fn? – jaresty Mar 14 '11 at 1:38
show 9 more comments

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.