Plaster

Annotations

• common-lisp default anonymous 2022.12.17 19:12:45

  (defpackage #:snippets/cryptography-problem (:use #:cl #:screamer #:screamer+) (:shadowing-import-from #:screamer #:defun)) (in-package #:snippets/cryptography-problem) ;; S E N D ;; M O R E ;; ========= ;; M O N E Y (defmacro as-integer (&rest digits) `(+v ,@(loop for d in digits for i from (- (length digits) 1) downto 0 collect `(*v ,d ,(expt 10 i))))) (defun cryptography-problem () (let ((vars (loop repeat 8 collect (an-integer-betweenv 0 9)))) (destructuring-bind (s e n d m o r y) vars (assert! (all-differentv s e n d m o r y)) (assert! (=v (+v (as-integer s e n d) (as-integer m o r e)) (as-integer m o n e y))) (solution vars (static-ordering #'linear-force))))) ;; (one-value (cryptography-problem)) ;; ==> (2 8 1 7 0 3 6 5) ;; ;; (all-values (cryptography-problem)) ;; ==> ((2 8 1 7 0 3 6 5) (2 8 1 9 0 3 6 7) (3 7 1 2 0 4 6 9) (3 7 1 9 0 4 5 6) ;; (3 8 2 1 0 4 6 9) (3 8 2 9 0 4 5 7) (5 7 3 1 0 6 4 8) (5 7 3 2 0 6 4 9) ;; (5 8 4 9 0 6 3 7) (6 4 1 5 0 7 3 9) (6 4 1 9 0 7 2 3) (6 5 2 4 0 7 3 9) ;; (6 8 5 1 0 7 3 9) (6 8 5 3 0 7 2 1) (7 3 1 6 0 8 2 9) (7 4 2 9 0 8 1 3) ;; (7 5 3 1 0 8 2 6) (7 5 3 4 0 8 2 9) (7 5 3 9 0 8 1 4) (7 6 4 3 0 8 2 9) ;; (7 6 4 9 0 8 1 5) (8 3 2 4 0 9 1 7) (8 4 3 2 0 9 1 6) (8 5 4 2 0 9 1 7) ;; (9 5 6 7 1 0 8 2))
• common-lisp default anonymous 2022.12.17 19:20:49

  (shadow 't) (defun solve () (declare (optimize speed)) (macrolet ((bind (letters &body body) (let ((digits '(0 1 2 3 4 5 6 7 8 9))) `(amb:amb ,(mapcar (lambda (x) `(,x ',digits)) letters) ,@body)))) (let ((iterations 0)) (declare (type fixnum iterations)) (bind (v i o l n a t r s) (incf iterations) ;; numbers must not start with 0 (amb:constrain (/= 0 v)) (amb:constrain (/= 0 t)) (amb:constrain (/= 0 s)) (let ((letters (list v i o l n a t r s))) (declare (dynamic-extent letters)) ;; the digits are all different (flet ((no-duplicate-digits (letters) (let ((bitfield 0)) (declare (type (unsigned-byte 10) bitfield)) (dolist (letter letters cl:t) (declare (type (integer 0 9) letter)) (amb:constrain (not (logbitp letter bitfield))) (let ((new (dpb 1 (byte 1 letter) bitfield))) (setf bitfield new)))))) (amb:constrain (no-duplicate-digits letters))) (flet ((make (&rest digits) (declare (dynamic-extent digits)) (destructuring-bind (acc . digits) digits (declare (type (integer 0 999999) acc)) (dolist (digit digits acc) (declare (type (integer 0 9) digit)) (setf acc (+ (* 10 acc) digit)))))) (let ((violin (make v i o l i n)) (viola (make v i o l a)) (trio (make t r i o)) (sonata (make s o n a t a))) (declare (type (integer 0 999999) violin viola trio sonata)) ;; VIOLIN * 2 + VIOLA = TRIO + SONATA (amb:constrain (= (+ (* violin 2) viola) (+ trio sonata))) (values (copy-list letters) iterations)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; CL-USER> (time (solve)) Evaluation took: 2.279 seconds of real time 2.279576 seconds of total run time (2.278194 user, 0.001382 system) 100.04% CPU 7,983,850,271 processor cycles 0 bytes consed (1 7 6 4 8 0 2 5 3)