HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Finding a cryptoarithmetic solution

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
solutioncryptoarithmeticfinding

Problem

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:


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.

```
(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 auge

Solution

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)

Code Snippets

(defun place-value-to-integer (the-list &OPTIONAL place-value) 
  (let ((place-value (if place-value place-value 1)))
  ...
(defun place-value-to-integer (the-list &OPTIONAL (place-value 1)) 
  ...
(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))))))
(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)

Context

StackExchange Code Review Q#1227, answer score: 3

Revisions (0)

No revisions yet.