Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.lisp > #59395 > unrolled thread
| Started by | HenHanna <HenHanna@gmail.com> |
|---|---|
| First post | 2024-02-25 20:30 -0800 |
| Last post | 2024-04-20 16:25 -0400 |
| Articles | 6 — 5 participants |
Back to article view | Back to comp.lang.lisp
Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable) code Sought HenHanna <HenHanna@gmail.com> - 2024-02-25 20:30 -0800
Re: Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable) code Sought Kaz Kylheku <433-929-6894@kylheku.com> - 2024-02-26 07:34 +0000
Re: Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable) code Sought Paul Rubin <no.email@nospam.invalid> - 2024-02-26 00:12 -0800
Re: Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable) code Sought Madhu <enometh@meer.net> - 2024-02-26 14:56 +0530
Re: Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable) code Sought Kaz Kylheku <433-929-6894@kylheku.com> - 2024-02-26 18:24 +0000
Re: Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable) code Sought steve <sgonedes1977@gmail.com> - 2024-04-20 16:25 -0400
| From | HenHanna <HenHanna@gmail.com> |
|---|---|
| Date | 2024-02-25 20:30 -0800 |
| Subject | Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable) code Sought |
| Message-ID | <urh45k$2br0h$2@dont-email.me> |
(i just wrote (non-elegant) Python code.)
Could you share a short, VERY Readable Pythonic (or Common Lisp, Scheme)
code that solves this?
Thank you!
https://i.imgur.com/72LGJjj.jpeg
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
HINT -- A mark of a great puzzle, this one contains a surprise or two.
[toc] | [next] | [standalone]
| From | Kaz Kylheku <433-929-6894@kylheku.com> |
|---|---|
| Date | 2024-02-26 07:34 +0000 |
| Message-ID | <20240225232022.380@kylheku.com> |
| In reply to | #59395 |
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
[toc] | [prev] | [next] | [standalone]
| From | Paul Rubin <no.email@nospam.invalid> |
|---|---|
| Date | 2024-02-26 00:12 -0800 |
| Message-ID | <87a5nn1w58.fsf@nightsong.com> |
| In reply to | #59395 |
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.
[toc] | [prev] | [next] | [standalone]
| From | Madhu <enometh@meer.net> |
|---|---|
| Date | 2024-02-26 14:56 +0530 |
| Message-ID | <m3v86bk241.fsf@leonis4.robolove.meer.net> |
| In reply to | #59397 |
* 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.
[toc] | [prev] | [next] | [standalone]
| From | Kaz Kylheku <433-929-6894@kylheku.com> |
|---|---|
| Date | 2024-02-26 18:24 +0000 |
| Message-ID | <20240226102023.256@kylheku.com> |
| In reply to | #59395 |
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
[toc] | [prev] | [next] | [standalone]
| From | steve <sgonedes1977@gmail.com> |
|---|---|
| Date | 2024-04-20 16:25 -0400 |
| Message-ID | <87jzkrzsq6.fsf@gmail.com> |
| In reply to | #59395 |
HenHanna <HenHanna@gmail.com> writes:
< (i just wrote (non-elegant) Python code.)
>
>
< Could you share a short, VERY Readable Pythonic (or Common Lisp, Scheme) code
< that solves this?
>
>
< Thank you!
>
< https://i.imgur.com/72LGJjj.jpeg
>
>
< 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
>
>
< HINT -- A mark of a great puzzle, this one contains a surprise or two.
(in-tre "Table Example")
(rule-file "ex1")
(assert! '(on d table))
(assert! '(on e d))
(assert! '(on f e))
(rule ((on ?x table) (on ?y ?x) (on ?z ?y))
(rassert! (3-tower ?x ?y ?z))
(show-data))
* hint the rest of the code is more verbose *
=>
(PROGN
(DEFUN EX1-ON-?X-TABLE-BODY/2 (?X)
"Body procedure when pattern: |(ON ?X TABLE)| matches."
(INSERT-RULE *TRE* (GET-DBCLASS *TRE* 'ON)
#'(LAMBDA (P) (EX1-ON-?Y-?X-MATCHER/2 P ?X))
#'(LAMBDA (?Y) (EX1-ON-?Y-?X-BODY/2 ?Y ?X)) NIL))
(DEFUN EX1-ON-?X-TABLE-MATCHER/2 (P)
"Match procedure for pattern: |(ON ?X TABLE)|."
(WHEN
(AND (CONSP P) (EQ 'ON (CAR P)) (CONSP (CDR P)) (CONSP (CDR (CDR P)))
(EQ 'TABLE (CAR (CDR (CDR P)))) (NULL (CDR (CDR (CDR P)))))
(VALUES T (LIST (CAR (CDR P))))))
(DEFUN EX1-ON-?Y-?X-BODY/2 (?Y ?X)
"Body procedure when pattern: |(ON ?Y ?X)| matches."
(INSERT-RULE *TRE* (GET-DBCLASS *TRE* 'ON)
#'(LAMBDA (P) (EX1-ON-?Z-?Y-MATCHER/2 P ?Y ?X))
#'(LAMBDA (?Z) (EX1-ON-?Z-?Y-BODY/2 ?Z ?Y ?X)) NIL))
(DEFUN EX1-ON-?Y-?X-MATCHER/2 (P ?X)
"Match procedure for pattern: |(ON ?Y ?X)|."
(WHEN
(AND (CONSP P) (EQ 'ON (CAR P)) (CONSP (CDR P)) (CONSP (CDR (CDR P)))
(EQL ?X (CAR (CDR (CDR P)))) (NULL (CDR (CDR (CDR P)))))
(VALUES T (LIST (CAR (CDR P))))))
(DEFUN EX1-ON-?Z-?Y-BODY/2 (?Z ?Y ?X)
"Body procedure when pattern: |(ON ?Z ?Y)| matches."
(ASSERT! (CONS '3-TOWER (CONS ?X (CONS ?Y (CONS ?Z NIL)))))
(SHOW-DATA))
(DEFUN EX1-ON-?Z-?Y-MATCHER/2 (P ?Y ?X)
"Match procedure for pattern: |(ON ?Z ?Y)|."
(WHEN
(AND (CONSP P) (EQ 'ON (CAR P)) (CONSP (CDR P)) (CONSP (CDR (CDR P)))
(EQL ?Y (CAR (CDR (CDR P)))) (NULL (CDR (CDR (CDR P)))))
(VALUES T (LIST (CAR (CDR P))))))
(INSERT-RULE *TRE* (GET-DBCLASS *TRE* 'ON) #'EX1-ON-?X-TABLE-MATCHER/2
#'EX1-ON-?X-TABLE-BODY/2 NIL))
(show) =>
TRE> (show)
;; In global context:
;; Facts: (ON F E)
;; Facts: (ON E D)
;; Facts: (ON D TABLE)
;; 3 assertions in global context.
;; In global context:
;; Rule 1 (N): ON
;; Matcher: EX1-ON-?X-TABLE-MATCHER/2
;; (LAMBDA (P)
;; "Match procedure for pattern: |(ON ?X TABLE)|."
;; (BLOCK EX1-ON-?X-TABLE-MATCHER/2
;; (WHEN
;; (AND (CONSP P) (EQ 'ON (CAR P)) (CONSP (CDR P)) (CONSP (CDR (CDR P)))
;; (EQ 'TABLE (CAR (CDR (CDR P)))) (NULL (CDR (CDR (CDR P)))))
;; (VALUES T (LIST (CAR (CDR P)))))))
;;
;; Body: EX1-ON-?X-TABLE-BODY/2
;; (LAMBDA (?X)
;; "Body procedure when pattern: |(ON ?X TABLE)| matches."
;; (BLOCK EX1-ON-?X-TABLE-BODY/2
;; (INSERT-RULE *TRE* (GET-DBCLASS *TRE* 'ON) #'(LAMBDA (P) (EX1-ON-?Y-?X-MATCHER/2 P ?X))
;; #'(LAMBDA (?Y) (EX1-ON-?Y-?X-BODY/2 ?Y ?X)) NIL)))
;;
;; 1 global rule.
TRE> (run-rules *tre*)
;; insert-new fact: (3-TOWER D E F)
;; In global context:
;; Facts: (ON F E)
;; Facts: (ON E D)
;; Facts: (ON D TABLE)
;; Facts: (3-TOWER D E F)
;; 4 assertions in global context.
;; Table Example(0): 3 rules run.
NIL
TRE>
TRE> (show)
;; In global context:
;; Facts: (ON F E)
;; Facts: (ON E D)
;; Facts: (ON D TABLE)
;; Facts: (3-TOWER D E F)
;; 4 assertions in global context.
;; In global context:
;; Rule 1 (N): ON
;; Matcher: EX1-ON-?X-TABLE-MATCHER/2
;; (LAMBDA (P)
;; "Match procedure for pattern: |(ON ?X TABLE)|."
;; (BLOCK EX1-ON-?X-TABLE-MATCHER/2
;; (WHEN
;; (AND (CONSP P) (EQ 'ON (CAR P)) (CONSP (CDR P)) (CONSP (CDR (CDR P)))
;; (EQ 'TABLE (CAR (CDR (CDR P)))) (NULL (CDR (CDR (CDR P)))))
;; (VALUES T (LIST (CAR (CDR P)))))))
;;
;; Body: EX1-ON-?X-TABLE-BODY/2
;; (LAMBDA (?X)
;; "Body procedure when pattern: |(ON ?X TABLE)| matches."
;; (BLOCK EX1-ON-?X-TABLE-BODY/2
;; (INSERT-RULE *TRE* (GET-DBCLASS *TRE* 'ON) #'(LAMBDA (P) (EX1-ON-?Y-?X-MATCHER/2 P ?X))
;; #'(LAMBDA (?Y) (EX1-ON-?Y-?X-BODY/2 ?Y ?X)) NIL)))
;;
;; Rule 2 (N): ON
;; Matcher: (LAMBDA (P) IN EX1-ON-?X-TABLE-BODY/2)
;; (LAMBDA (P) (EX1-ON-?Y-?X-MATCHER/2 P ?X))
;;
;; Body: (LAMBDA (?Y) IN EX1-ON-?X-TABLE-BODY/2)
;; (LAMBDA (?Y) (EX1-ON-?Y-?X-BODY/2 ?Y ?X))
;;
;; Rule 3 (N): ON
;; Matcher: (LAMBDA (P) IN EX1-ON-?Y-?X-BODY/2)
;; (LAMBDA (P) (EX1-ON-?Z-?Y-MATCHER/2 P ?Y ?X))
;;
;; Body: (LAMBDA (?Z) IN EX1-ON-?Y-?X-BODY/2)
;; (LAMBDA (?Z) (EX1-ON-?Z-?Y-BODY/2 ?Z ?Y ?X))
;;
;; 3 global rules.
3
TRE>
? close? old rule system from xerox called tre. see building problem
solvers.
[toc] | [prev] | [standalone]
Back to top | Article view | comp.lang.lisp
csiph-web