• #### Re: Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable)

From Paul Rubin@21:1/5 to HenHanna on Mon Feb 26 00:12:51 2024
XPost: fr.comp.lang.lisp, fj.comp.lang.lisp

HenHanna <HenHanna@gmail.com> writes:
Could you share a short, VERY Readable Pythonic (or Common Lisp,
Scheme) code that solves this?

This is getting spammy. It would have been preferable to cross post if
you were going to ask for different languages. (I posted a solution in comp.lang.python). It's a cute puzzle but the basic approach is the
same in any traditional language, more or less. It would be more
interesting to try something like Prolog where you'd use a built in
constraint solver.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)
• From Kaz Kylheku@21:1/5 to HenHanna on Mon Feb 26 07:34:52 2024
XPost: fr.comp.lang.lisp, fj.comp.lang.lisp

On 2024-02-26, HenHanna <HenHanna@gmail.com> wrote:
3 digit lock
[682]: One number is correct and well-placed
[614]: One number is correct but wrongly placed
[206]: Two numbers are correct but wrongly placed
[738]: Nothing is correct
[780]: One number is correct but wrongly placed

\$ txr lock.tl
(0 4 2)

Code in lock.tl:

(defmacro amb-scope (. forms)
^(block amb-scope ,*forms))

(defun amb (. args)
(suspend amb-scope cont
(each ((a args))
(whenlet ((res (and a (call cont a))))
(return-from amb-scope res)))))

(defsymacro all-ix #(0 1 2))

(defun well-placed (nc v1 v2 v3 n1 n2 n3)
(let ((ixs (perm all-ix 3))
(vv (vec v1 v2 v3))
(vn (vec n1 n2 n3)))
(some-true ((ix ixs))
(and (each-true ((i 0..nc))
(eql [vv [ix i]] [vn [ix i]]))
(each-false ((i nc..3))
(posql [vv [ix i]] vn))))))

(defun have-common (a b)
(some-true ((x a) (y b)) (eq x y)))

(defun badly-placed (nc v1 v2 v3 n1 n2 n3)
(let ((cixs (comb all-ix nc))
(pixs (perm all-ix nc))
(vv (vec v1 v2 v3))
(vn (vec n1 n2 n3)))
(some-true ((ix cixs))
(let ((oixs (remove-if (op have-common ix) pixs))
(nix (diff all-ix ix)))
(some-true ((oix oixs))
(and
(each-true ((i ix)
(j oix))
(eql [vv i] [vn j]))
(each-false ((i nix))
(posql [vv i] vn))))))))

(amb-scope
(let ((n1 (amb 0 1 2 3 4 5 6 7 8 9))
(n2 (amb 0 1 2 3 4 5 6 7 8 9))
(n3 (amb 0 1 2 3 4 5 6 7 8 9)))
(amb (well-placed 1 6 8 2 n1 n2 n3))
(amb (badly-placed 1 6 1 4 n1 n2 n3))
(amb (badly-placed 2 2 0 6 n1 n2 n3))
(amb (well-placed 0 7 3 8 n1 n2 n3))
(amb (badly-placed 1 7 8 0 n1 n2 n3))
(prinl ^(,n1 ,n2 ,n3))
nil))

HINT -- A mark of a great puzzle, this one contains a surprise or two.

Indeed; since it contains no surprise, it must contain two,
which it does.

--
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)
• From Madhu@21:1/5 to All on Mon Feb 26 14:56:38 2024
* Paul Rubin <87a5nn1w58.fsf @nightsong.com> :
Wrote on Mon, 26 Feb 2024 00:12:51 -0800:
HenHanna <HenHanna@gmail.com> writes:
Could you share a short, VERY Readable Pythonic (or Common Lisp,
Scheme) code that solves this?

This is getting spammy. It would have been preferable to cross post if
you were going to ask for different languages. (I posted a solution in comp.lang.python). It's a cute puzzle but the basic approach is the
same in any traditional language, more or less. It would be more
interesting to try something like Prolog where you'd use a built in constraint solver.

I got started on that, but gave up and brute forced it

https://i.imgur.com/72LGJjj.jpeg
[682]: One number is correct and well-placed
[614]: One number is correct but wrongly placed
[206]: Two numbers are correct but wrongly placed
[738]: Nothing is correct
[780]: One number is correct but wrongly placed

- First was to come up with a notation to express these constraints.
A 3-tuple which can contain a number, or a constraint or a wildcard.

so "(6[^4].)" would be all 3 digit numbers with 6 at the first position,
not having 4 at the second position and any number ("." is a wildcard)
in the third position.

Then the rules would be assembled into graph which would constrain any generated numbers that fell through it. On the other hand a checker
could be generated and compiled, since the search space is small enough.

(defun make-num-clause (n index)
`(eql ,(ecase index
(1 'n1)
(2 'n2)
(3 'n3))
,n))

(defun make-or-clause (clauses)
`(or ,@clauses))

(defun make-and-clause (clauses)
`(and ,@clauses))

(defun make-not-clause (clause)
`(not ,clause))

(defun spec-item-reader (stream &optional subchar arg)
(declare (ignorable subchar arg))
(let ((i 0) c ret n (index 1))
(assert (eql c #\())
(incf i)
(loop
(cond ((setq n (digit-char-p (setq c (read-char stream))))
(push (make-num-clause n index) ret))
((eql c #\.) t) ;wildcard
((eql c #\))
(return (make-and-clause (nreverse ret))))
((eql c #\[)
(incf i)
(cond ((eql (read-char stream i) #\^)
(incf i)
(let (clauses)
(loop
(cond ((eql (setq c (read-char stream)) #\])
(push (make-not-clause (make-or-clause (nreverse clauses))) ret)
(return))
(t (assert (setq n (digit-char-p c)))
(push (make-num-clause n index) clauses)
(incf i))))))
(t (let (clauses)
(loop
(cond ((eql (setq c (read-char stream)) #\])
(push (make-or-clause (nreverse clauses)) ret)
(return))
(t (assert (setq n (digit-char-p c)))
(push (make-num-clause n index) clauses)
(incf i)))))))))
(incf i)
(incf index)
(assert (not (> index 4))))))

(:merge :standard)

(defun ONE-OF (&rest list)
(make-or-clause list))

(defun ALL-OF (&rest list)
(make-and-clause list))

;;; then translate the list of constraints

;; (682): One number is correct and well-placed
(defvar \$c1
(ONE-OF '#?(6..) '#?(.8.) '#?(..2)))

;; (614): One number is correct but wrongly placed
(defvar \$c2
(ONE-OF (ONE-OF (ALL-OF '#?(.6.) '#?(.[^14].)) ;6 is correct
(ALL-OF '#?(..6) '#?(..[^14])))
(ONE-OF (ALL-OF '#?(1..) '#?([^46]..)) ;1 is correct
(ALL-OF '#?(..1) '#?(..[^46])))
(ONE-OF (ALL-OF '#?(4..) '#?([^16]..)) ;4 is corrcet
(ALL-OF '#?(.4.) '#?(.[^16].)))))

;; (206): Two numbers are correct but wrongly placed
(defvar \$c3
(ONE-OF (ONE-OF '#?(.20) '#?(02.) '#?(0.2)) ;; 2 & 0 are correct
(ONE-OF '#?(62.) '#?(6.2) '#?(.26)) ;; 2 & 6 are correct
(ONE-OF '#?(06.) '#?(6.0) '#?(.60)) ;; 0 & 6 are correct
))

;; (738): Nothing is correct
(defvar \$c4
'#?([^738][^738][^783]))

;; (780): One number is correct but wrongly placed
(defvar \$c5
(ONE-OF (ONE-OF '#?(.7.) '#?(..7)) ;; 7 is correct
(ONE-OF '#?(8..) '#?(..8)) ;; 8 is correct
(ONE-OF '#?(0..) '#?(.0.)) ;; 0 is correct
))

(defmacro defchecker ()
`(defun checker (n1 n2 n3)
,(all-of \$c1 \$c2 \$c3 \$c4 \$c5)))

(defchecker)

(defun check()
(let (results)
(loop for n1 from 0 below 10
do (loop for n2 from 0 below 10
do (loop for n3 from 1 below 10
if (checker n1 n2 n3)
do (push (list n1 n2 n3) results))))
results))

((0 6 2) (0 4 2))

took 41 microseconds (0.000041 seconds) to run.
During that period, and with 8 available CPU cores,
41 microseconds (0.000041 seconds) were spent in user mode
9 microseconds (0.000009 seconds) were spent in system mode
128 bytes of memory allocated.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)
• From Kaz Kylheku@21:1/5 to HenHanna on Mon Feb 26 18:24:38 2024
XPost: fr.comp.lang.lisp, fj.comp.lang.lisp

On 2024-02-26, HenHanna <HenHanna@gmail.com> wrote:

(i just wrote (non-elegant) Python code.)

Could you share a short, VERY Readable Pythonic (or Common Lisp, Scheme)
code that solves this?

TXR Lisp, using scoring method:

(defun score (pat can)
(vec (sum-each ((p pat) (c can))
(if (eql p c) 1 0))
(len (isec pat can))))

(defun filt-score (pat ngoodpl nbadpl list)
(keep-if (op equal (score pat @1) (vec ngoodpl nbadpl)) list))

(flow "000".."999"
list-seq
(filt-score "682" 1 1)
(filt-score "614" 0 1)
(filt-score "206" 0 2)
;; surprises: these two not required
(filt-score "738" 0 0)
(filt-score "780" 0 1)
prinl)

\$ txr lock2.tl
("042")

--
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)