Path: ...!Xl.tags.giganews.com!local-1.nntp.ord.giganews.com!news.giganews.com.POSTED!not-for-mail
NNTP-Posting-Date: Sat, 20 Apr 2024 20:25:54 +0000
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>
User-Agent: Gnus/5.13 (Gnus v5.13)
Date: Sat, 20 Apr 2024 16:25:53 -0400
Message-ID: <87jzkrzsq6.fsf@gmail.com>
Cancel-Lock: sha1:hqmuEdvkKCV4v0q1fHv1C00Ui6Y=
MIME-Version: 1.0
Content-Type: text/plain
Lines: 167
X-Usenet-Provider: http://www.giganews.com
X-Trace: sv3-6yXOq3RyLE9DtC60Ww4Q5DuRTILHsV+pD7CaVSKmLMM+dkL8Fmq7x/vRHsSZU0rgSwoAE318kMEzKzV!n4imQsRDnsBM9bLYZFVwtXZgQ5huPGPDoOWbUlyYnP97Uw==
X-Complaints-To: abuse@giganews.com
X-DMCA-Notifications: http://www.giganews.com/info/dmca.html
X-Abuse-and-DMCA-Info: Please be sure to forward a copy of ALL headers
X-Abuse-and-DMCA-Info: Otherwise we will be unable to process your complaint properly
X-Postfilter: 1.3.40
Bytes: 6780

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.