* 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))
(setq c (read-char stream))
(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))))))
(require 'named-readtables)
(named-readtables:defreadtable :henna-lock-spec-syntax
(:merge :standard)
(:dispatch-macro-char #\# #\? #'spec-item-reader))
(named-readtables:in-readtable :henna-lock-spec-syntax)
(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)
