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.