patternMinor
Finding a cryptoarithmetic solution
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:
has a solution
For each of the below cryptoarithmetic problems, write a program that finds all
the solutions in the shortest possible time.
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
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
___
OKhas 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 OKI 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
When working with optional arguments, you can set defaults for them.
can be written as
I don't have time to get into the rest right now, but you're using
EDIT:
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.
EDIT (by jaresty): adding comments to show example intermediate values for "solution-fn"
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.