Warning: mysqli::__construct(): (HY000/1203): User howardkn already has more than 'max_user_connections' active connections in D:\Inetpub\vhosts\howardknight.net\al.howardknight.net\includes\artfuncs.php on line 21
Failed to connect to MySQL: (1203) User howardkn already has more than 'max_user_connections' active connectionsPath: ...!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
Newsgroups: comp.lang.lisp
Subject: Re: Mastermind Puzzle (3-digit Combination Lock) -- Elegant (readable) code Sought
Organization:
References:
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 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.