Groups | Search | Server Info | Login | Register
Groups > comp.lang.lisp > #59556
| From | steve <sgonedes1977@gmail.com> |
|---|---|
| Newsgroups | comp.lang.lisp |
| Subject | Re: Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable) code Sought |
| Organization | |
| References | <urh45k$2br0h$2@dont-email.me> |
| Date | 2024-04-20 16:25 -0400 |
| Message-ID | <87jzkrzsq6.fsf@gmail.com> (permalink) |
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.
Back to comp.lang.lisp | Previous | Next — Previous in thread | Find similar
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
csiph-web