Найти решение cryptoarithmetic


Данный код предназначен для поиска всех возможных путей решения проблемы cryptoarithmetic. Описание проблемы я пытался решить это здесь:

В проблемы cryptoarithmetic, у нас есть проблемы, где цифры заменяются на символы, представляющие цифры. Решение такая проблема представляет собой набор цифр, что при замене в проблемы, дает точное численное толкование.

Пример:

IS
IT
___
OK

есть решение

{ I = 1; K = 1; O = 3; S = 5; T = 6}

Для каждого из указанных ниже проблем cryptoarithmetic, написать программу, которая находит все решения в кратчайшие сроки.

IS     I
IT    AM
__    __
OK    OK

Я был только в состоянии решить с помощью грубой силы, хотя я считаю, что есть более эффективные методы. Я тоже в надежде получить отзыв на мое форматирование, именование, и действительно все, что вы думаете, что может использовать улучшение.

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


667
4
задан 10 марта 2011 в 06:03 Источник Поделиться
Комментарии
1 ответ

Некоторые предварительные заметки сейчас (я добавлю позже):

Когда нужно писать (если N н 2) или (если (не н) 2 н), вы можете вместо этого написать (или N 2). или будет принимать любое количество аргументов и возвращает либо ноль или первый аргумент, который оценивает непропустит.


При работе с необязательными аргументами, можно задать значения по умолчанию для них.

(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)) 
...


У меня нет времени, чтобы попасть на отдых прямо сейчас, но вы используете цикл для чтения серии хэш - значений, который говорит мне, что вы могли бы упростить это с помощью более функционального подхода (это может быть одно из исключений, но это не кажется на первый взгляд).

Редактировать:

(если б нет) эквивалентно (при Б) (и это хороший стиль, чтобы использовать второго над первым).

EDIT2: ОК, вау, Эй. Это два часа моей жизни я не вернусь. Я писал и редактировал очень смехотворно длинный кусок на мой процесс (если вы заботитесь, это здесь). Вот как я бы решить грубой силы подход к этой проблеме.

EDIT3: слегка упрощенный.

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

Редактирование (по jaresty): добавление комментариев, чтобы показать пример промежуточных значений для "решения-ФН"

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

3
ответ дан 11 марта 2011 в 05:03 Источник Поделиться