Re: Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable) code Sought

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.