CLIPS: slots within multislots - oop

I am currently working in CLIPS and I am new to it. I am trying to replicate the following information in a CLIPS deftemplate:
[Person, [Class,Class],[[M 9,11],[F,9,11]]]
It has a person, multiple classes that they can take and the times that they can take the class. I try to replicate this information in the following deftemplate:
(deftemplate person
(slot Name)
(multislot Class)
(multislot Available))
My problem is I do not understand what I am supposed to do in the available multislot because it has three inputs. Is there a way that I can make slots within a multislot? I have looked online for ways to do this but have not been able to correctly solve this problem.

Here are four different approaches. I would suggest something similar to approach 3 or 4 since these involve simple linkages between facts/instances.
CLIPS> (clear) ; Approach 1
CLIPS>
(deftemplate person
(slot Name)
(multislot Class)
(multislot Available))
CLIPS>
(deffacts people
(person (Name Frank)
(Class Biology Calculus)
(Available M 9 11 F 9 11)))
CLIPS>
(deffunction #-of-triplets (?mf)
(div (length$ ?mf) 3))
CLIPS>
(deffunction nth-triplet (?mf ?n)
(subseq$ ?mf (+ 1 (* (- ?n 1) 3))(* ?n 3)))
CLIPS>
(defrule print-availability
(person (Name ?name)
(Available $?a))
=>
(loop-for-count (?i (#-of-triplets ?a))
(bind ?triplet (nth-triplet ?a ?i))
(bind ?d (nth$ 1 ?triplet))
(bind ?b (nth$ 2 ?triplet))
(bind ?e (nth$ 3 ?triplet))
(printout t ?name " " ?d " " ?b " " ?e crlf)))
CLIPS> (reset)
CLIPS> (run)
Frank M 9 11
Frank F 9 11
CLIPS> (clear) ; Approach 2
CLIPS>
(deftemplate person
(slot Name)
(multislot Class)
(multislot Available-Weekday)
(multislot Available-Begin)
(multislot Available-End))
CLIPS>
(deffacts people
(person (Name Frank)
(Class Biology Calculus)
(Available-Weekday M F)
(Available-Begin 9 9)
(Available-End 11 11)))
CLIPS>
(defrule print-availability
(person (Name ?name)
(Available-Weekday $?f1 ?d $?)
(Available-Begin $?f2 ?b $?)
(Available-End $?f3 ?e $?))
(test (= (length$ ?f1)
(length$ ?f2)
(length$ ?f3)))
=>
(printout t ?name " " ?d " " ?b " " ?e crlf))
CLIPS> (reset)
CLIPS> (run)
Frank M 9 11
Frank F 9 11
CLIPS> (clear) ; Approach 3
CLIPS>
(deftemplate person
(slot Name)
(slot ID)
(multislot Class))
CLIPS>
(deftemplate availability
(slot owner-ID)
(slot Weekday)
(slot Begin)
(slot End))
CLIPS>
(deffacts information
(person (Name Frank) (ID 1)
(Class Biology Calculus))
(availability (owner-ID 1) (Weekday M) (Begin 9) (End 11))
(availability (owner-ID 1) (Weekday F) (Begin 9) (End 11)))
CLIPS>
(defrule print-availability
(person (Name ?name) (ID ?id))
(availability (owner-ID ?id) (Weekday ?d) (Begin ?b) (End ?e))
=>
(printout t ?name " " ?d " " ?b " " ?e crlf))
CLIPS> (reset)
CLIPS> (run)
Frank F 9 11
Frank M 9 11
CLIPS> (clear) ; Approach 4
CLIPS>
(defclass PERSON
(is-a USER)
(slot Name)
(multislot Class)
(multislot Available))
CLIPS>
(defclass AVAILABILITY
(is-a USER)
(slot Weekday)
(slot Begin)
(slot End))
CLIPS>
(definstances information
(of PERSON (Name Frank)
(Class Biology Calculus)
(Available (make-instance of AVAILABILITY (Weekday M) (Begin 9) (End 11))
(make-instance of AVAILABILITY (Weekday F) (Begin 9) (End 11)))))
CLIPS>
(defrule print-availability
(object (is-a PERSON) (Name ?name) (Available $? ?a $?))
(object (is-a AVAILABILITY) (name ?a))
=>
(printout t ?name " " (send ?a get-Weekday)
" " (send ?a get-Begin)
" " (send ?a get-End) crlf)))
CLIPS> (reset)
CLIPS> (run)
Frank F 9 11
Frank M 9 11
CLIPS>

Related

Clips not printing anything

I tried to write the following code in CLIPS for a school project (even though I don't understand why AI is done in this language):
(deftemplate blood
(slot bt)
(multislot acc))
(deffacts acceptance
(blood (bt 0) (acc 0 0))
(blood (bt A) (acc 0 A))
(blood (bt B) (acc 0 B))
(blood (bt AB) (acc 0 A B AB)))
(defrule reading-input
=>
(printout t "Bloodtype of patient? ")
(assert (patient (read)))
(printout t "Bloodtype of donor? ")
(assert (donor (read))))
(defrule check-acceptance
(patient ?patient)
(donor ?donor)
(blood (bt ?bt1) (acc ?acc1))
(test (member$ ?donor ?acc1))
=>
(printout t "Transfusion is safe" crlf))
For some reason it wouldn't print anything for inputs A and A or anything else. I also tried this with a if then else statement, but same result.
[prev code]
(blood (bt ?bt1) (acc ?acc1))
=>
(if (eq ?patient ?bt1)
then
(printout t ?bt1)
else
(printout t ?donor)))
The idea is to write a program that prints whether blood transfusion is safe or not.
Modify your blood pattern so that the bt slot is restricted to the blood type of the patient and change the variable acc1 to a multifield variable so that it will bind to all of the values in the acc slot:
(defrule check-acceptance
(patient ?patient)
(donor ?donor)
(blood (bt ?patient) (acc $?acc1))
(test (member$ ?donor ?acc1))
=>
(printout t "Transfusion is safe" crlf))

Racket. Fill the table with data from database

I'm trying to fill the table in my GUI with data from database.
Here's the database example:
Team
---------------------------------------------------------
| id | name | city | coach |
---------------------------------------------------------
| 1 | Atlanta Hawks | Atlanta | Lloyd Pierce |
| 2 | Boston Celtics| Boston | Brad Stevens |
| 3 | Chicago Bulls | Chicago | Jim Boylen |
| 4 | Brooklyn Nets | New-York | Jacque Vaughn|
Tournament
-----------------------------------------------------------------------
| id | name | city | prise | year |
-----------------------------------------------------------------------
| 1 | FirstCup | Atlanta | 100000 | 2018 |
| 2 | SecondCup | Boston | 200000 | 2019 |
| 3 | ThirdCup | Chicago | 300000 | 2017 |
| 4 | AnotherCup | New-York | 400000 | 2020 |
And here's my GUI with some dummy data in tab-panels:
#lang racket
(require
racket/gui/base
racket/class
racket/list)
(require db)
(define pgc
(postgresql-connect #:user "postgres"
#:database "bascketball"
#:password "root"))
(define Team-Table #f)
(define Tournament-Table #f)
(define Team-Data #f)
(define Tournament-Data #f)
(define Basketball-App #f)
(define Main-Frame #f)
(define Group-Box #f)
(define Horizontal-Pane-Menu #f)
(define Tab-Panel #f)
(define Team-Tab #f)
(define Tournament-Tab #f)
(define (Basketball-App-init
(Main-Frame-width 800)
(Main-Frame-height 600))
(set! Main-Frame
(new
frame%
(parent Basketball-App)
(label "Basketball App")
(width Main-Frame-width)
(height Main-Frame-height)))
(set! Group-Box
(new
group-box-panel%
(parent Main-Frame)
(label "")
(alignment (list 'right 'bottom))))
(set! Horizontal-Pane-Menu
(new
horizontal-pane%
(parent Group-Box)
(stretchable-width #f)
(stretchable-height #f)))
(set! Tab-Panel
(new
(class tab-panel%
(super-new)
(define child-panels '())
(define/public
(add-child-panel p label)
(set! child-panels (append child-panels (list p)))
(send this append label)
(when (> (length child-panels) 1) (send this delete-child p)))
(define/public
(active-child n)
(send this change-children
(lambda (children) (list (list-ref child-panels n))))))
(parent Group-Box)
(choices (list))
(callback (λ (tp e) (send tp active-child (send tp get-selection))))
(stretchable-width #t)
(stretchable-height #t)))
(set! Team-Tab
(new
(class vertical-panel%
(init parent)
(init-field label)
(super-new (parent parent))
(send parent add-child-panel this label))
(parent Tab-Panel)
(label "Team")
(alignment (list 'left 'center))))
(set! Team-Table (new list-box%
[parent Team-Tab]
[choices (list )]
[label ""]
[style (list 'single 'column-headers 'variable-columns)]
[columns (list "Id" "Name" "City" "Coach")]))
#: Dummy data
(set! Team-Data (list (list "TeamTest" "TeamTest" "TeamTest")
(list "TeamTest" "TeamTest" "TeamTest")
(list "TeamTest" "TeamTest" "TeamTest")
(list "TeamTest" "TeamTest" "TeamTest")))
(send Team-Table set (list-ref Team-Data 0) (list-ref Team-Data 1) (list-ref Team-Data 2) (list-ref Team-Data 3))
(set! Tournament-Tab
(new
(class vertical-panel%
(init parent)
(init-field label)
(super-new (parent parent))
(send parent add-child-panel this label))
(parent Tab-Panel)
(label "Tournament")
(alignment (list 'left 'center))))
(set! Tournament-Table (new list-box%
[parent Tournament-Tab]
[choices (list )]
[label ""]
[style (list 'single 'column-headers 'variable-columns)]
[columns (list "Id" "Name" "City" "Prise" "Year")]))
#: Dummy data
(set! Tournament-Data (list (list "TournamentTest" "TournamentTest" "TournamentTest")
(list "TournamentTest" "TournamentTest" "TournamentTest")
(list "TournamentTest" "TournamentTest" "TournamentTest")
(list "TournamentTest" "TournamentTest" "TournamentTest")
(list "TournamentTest" "TournamentTest" "TournamentTest")))
(send Tournament-Table set (list-ref Tournament-Data 0) (list-ref Tournament-Data 1) (list-ref Tournament-Data 2) (list-ref Tournament-Data 3) (list-ref Tournament-Data 4))
(send Main-Frame show #t))
(module+ main (Basketball-App-init))
So I want to load data from database when I'm switch to tab and fill the table with loaded data.
I have two problems with this:
First - How should I know when user switch the tab and what tab is it (in other words, where should I put my SQL query to use it only when the tab switches).
Second - When I'm using some kind of this queries:
(query-rows pgc "select * from team")
I get just a string and I have no idea how to put this string to my table. I have to split this string and put every element as a cell of a table.
So, what's your advice in this project?

(assoc element alist) get all the entities autolisp

I've googled for it for a while but I didn't find the solution.
I've this list:
((-1 . <Nome entità: 7ff5ff905910>) (0 . "DICTIONARY") (5 . "1F9") (102 . "{ACAD_REACTORS") (330 . <Nome entità: 7ff5ff9038c0>) (102 . "}") (330 . <Nome entità: 7ff5ff9038c0>) (100 . "AcDbDictionary") (280 . 0) (281 . 1) (3 . "1") (350 . <Nome entità: 7ff5ff9933c0>) (3 . "2") (350 . <Nome entità: 7ff5ff9fa0d0>) (3 . "3") (350 . <Nome entità: 7ff5ff9fa410>))
I want to get all the entities with dxf code 350.
With that instruction I can get only the fist one.
(assoc 350 list)
How to get all the associations?
Thanks, Dennis
There are various ways to achieve this - here are a few examples:
(defun mAssoc1 ( key lst / rtn )
(foreach x lst
(if (= key (car x))
(setq rtn (cons (cdr x) rtn))
)
)
(reverse rtn)
)
(defun mAssoc2 ( key lst )
(apply 'append
(mapcar
(function
(lambda ( x ) (if (= key (car x)) (list (cdr x))))
)
lst
)
)
)
(defun mAssoc3 ( key lst )
(mapcar 'cdr
(vl-remove-if-not
(function (lambda ( x ) (= key (car x))))
lst
)
)
)
(defun mAssoc4 ( key lst / item )
(if (setq item (assoc key lst))
(cons (cdr item) (mAssoc4 key (cdr (member item lst))))
)
)
(defun mAssoc5 ( key lst / item rtn )
(while (setq item (assoc key lst))
(setq rtn (cons (cdr item) rtn) lst (cdr (member item lst)))
)
(reverse rtn)
)
(defun mAssoc6 ( key lst )
(mapcar 'cdr (acet-list-m-assoc key lst))
)
(defun mAssoc7 ( key lst )
(if lst
(if (= key (caar lst))
(cons (cdar lst) (mAssoc7 key (cdr lst)))
(mAssoc7 key (cdr lst))
)
)
)
Here is a quick performance comparison for the above functions:
;;; Benchmarking: Elapsed milliseconds / relative speed for 32768 iteration(s):
;;;
;;; (MASSOC4 2 L).....1482 / 1.25 <fastest>
;;; (MASSOC5 2 L).....1482 / 1.25
;;; (MASSOC6 2 L).....1498 / 1.24
;;; (MASSOC3 2 L).....1638 / 1.13
;;; (MASSOC7 2 L).....1747 / 1.06
;;; (MASSOC1 2 L).....1748 / 1.06
;;; (MASSOC2 2 L).....1856 / 1 <slowest>
assoc returns only first one, so You need to loop by all after find one as long as none is found (assoc returns nil). You should try such code:
(defun DXF:Dump (EntDef code / out)
(while (setq values(assoc code EntDef))
(setq out (append out (list (cdr values))))
(setq EntDef(cdr(member values EntDef)))
)
out
)
; (setq dxfs (entget (car (entsel))))
; (DXF:Dump dxfs 350)

Eight Queens Puzzle in CLIPS

I'm trying to develop an solver for the eight queens problem (https://en.wikipedia.org/wiki/Eight_queens_puzzle) in CLIPS, but I'm a newbie in this language.
First of all, I was trying to make a rule to verify a new assertion comparing column/line of previous assertions. Its working when is inserted a duplicated line, however when inserted a duplicated column, it doesn't detect it. What's wrong with this code?
(defrule verificaAssercaoDamas ; verifica se atende as regras
?novaPosicao <- (d ?line ?column)
?posicao <- (d ?line2 ?column2)
(test (neq ?posicao ?novaPosicao))
(test (or (eq ?line2 ?line) (eq ?column column2)) )
=>
(retract ?novaPosicao)
(if (< (+ ?column 1) 9)
then (assert (d ?line (+ ?column 1) ))
)
CLIPS> (assert(d 0 0))
<Fact-1>
CLIPS> (assert(d 1 0))
<Fact-2>
CLIPS> (assert(d 0 1))
<Fact-3>
CLIPS> (agenda)
0 cerificaAssercaoDamas: f-3, f-1
0 cerificaAssercaoDamas: f-1, f-3
For a total of 2 activations.
CLIPS>
You're using the expression (eq ?column column2) which is comparing the variable ?column to the symbol column2. You need to compare it to the variable ?column2.
CLIPS> (clear)
CLIPS>
(defrule verificaAssercaoDamas
?novaPosicao <- (d ?line ?column)
?posicao <- (d ?line2 ?column2)
(test (neq ?posicao ?novaPosicao))
(test (or (eq ?line2 ?line) (eq ?column ?column2)))
=>
(retract ?novaPosicao)
(if (< (+ ?column 1) 9)
then (assert (d ?line (+ ?column 1)))))
CLIPS> (assert (d 0 0))
<Fact-1>
CLIPS> (assert (d 1 0))
<Fact-2>
CLIPS> (assert (d 0 1))
<Fact-3>
CLIPS> (agenda)
0 verificaAssercaoDamas: f-3,f-1
0 verificaAssercaoDamas: f-1,f-3
0 verificaAssercaoDamas: f-2,f-1
0 verificaAssercaoDamas: f-1,f-2
For a total of 4 activations.
CLIPS>
If you're testing equality/inequality of numbers, you should use the = and != (or <>) functions as these will throw errors for non-numeric arguments:
CLIPS> (clear)
CLIPS>
(defrule verificaAssercaoDamas
?novaPosicao <- (d ?line ?column)
?posicao <- (d ?line2 ?column2)
(test (neq ?posicao ?novaPosicao))
(test (or (= ?line2 ?line) (= ?column column2)))
=>
(retract ?novaPosicao)
(if (< (+ ?column 1) 9)
then (assert (d ?line (+ ?column 1)))))
[ARGACCES5] Function = expected argument #2 to be of type integer or float
ERROR:
(defrule MAIN::verificaAssercaoDamas
?novaPosicao <- (d ?line ?column)
?posicao <- (d ?line2 ?column2)
(test (neq ?posicao ?novaPosicao))
(test (or (= ?line2 ?line) (= ?column column2)
CLIPS>
You can also remove the duplicate activations by checking that the fact index of ?novaPosicao is greater than the one for ?posicao:
CLIPS> (clear)
CLIPS>
(defrule verificaAssercaoDamas
?novaPosicao <- (d ?line ?column)
?posicao <- (d ?line2 ?column2)
(test (< (fact-index ?posicao) (fact-index ?novaPosicao)))
(test (or (= ?line2 ?line) (= ?column ?column2)))
=>
(retract ?novaPosicao)
(if (< (+ ?column 1) 9)
then (assert (d ?line (+ ?column 1)))))
CLIPS> (assert (d 0 0))
<Fact-1>
CLIPS> (assert (d 1 0))
<Fact-2>
CLIPS> (assert (d 0 1))
<Fact-3>
CLIPS> (agenda)
0 verificaAssercaoDamas: f-3,f-1
0 verificaAssercaoDamas: f-2,f-1
For a total of 2 activations.
CLIPS>

chess: bishop move with CLIPS

I'm trying to implement the possible moves of a bishop on a chess table, which can have other pieces on random cells. I've been able to make a sketch of an answer, but it doesn't detect other pieces.
Previously to this rule I've written some code that creates a fact like the following for each cell of the table, indicating its contents:
(cell-info (coor {i} {j}) (contents {empty|black|white}))
and a fact that shows the position of a piece:
(piece (row {r}) (column {c}) (type {t}) (color {col}))
And here's my rule so far (probably it's also not too efficient):
(defrule bishop-moves
(declare (salience 30))
(piece (row ?rb) (column ?cb) (type bishop) (color black))
(cell-info (coor ?i ?j) (contents empty|white))
=>
(loop-for-count (?n 1 8)
(if (or (and (= ?i (+ ?rb ?n)) (= ?j (+ ?cb ?n)))
(and (= ?i (- ?rb ?n)) (= ?j (- ?cb ?n)))
(and (= ?i (+ ?rb ?n)) (= ?j (- ?cb ?n)))
(and (= ?i (- ?rb ?n)) (= ?j (+ ?cb ?n))))
then (assert (movement-allowed
(destination-cell ?i ?j)
(type bishop)
(start-cell ?rb ?cb))))))
Does anybody now what could I do? Thanks in advance.
;;; Added deftemplates and deffacts
;;; Replaced rule variable ?i with ?r and ?j with ?c.
;;; Made rule applicable for both black or white bishop
;;; Moved diagonal logic from actions of rule to conditions
;;; Added logic to rule for intervening pieces
(deftemplate piece (slot row) (slot column) (slot type) (slot color))
(deftemplate cell-info (multislot coor) (slot contents))
(deftemplate movement-allowed (multislot destination-cell) (slot type) (multislot start-cell))
(deffacts test-data
(piece (row 1) (column 1) (type pawn) (color black))
(cell-info (coor 1 1) (contents black)) ; Invalid - friendly piece
(cell-info (coor 1 2) (contents empty)) ; Invalid - not on diagonal
(cell-info (coor 1 3) (contents empty)) ; Valid
(piece (row 2) (column 2) (type bishop) (color black))
(cell-info (coor 2 2) (contents black)) ; Invalid - friendly piece
(cell-info (coor 2 8) (contents empty)) ; Invalid - not on diagonal
(cell-info (coor 3 1) (contents empty)) ; Valid
(cell-info (coor 3 3) (contents empty)) ; Valid
(cell-info (coor 4 4) (contents empty)) ; Valid
(cell-info (coor 5 5) (contents empty)) ; Valid
(piece (row 6) (column 6) (type pawn) (color white))
(cell-info (coor 6 6) (contents white)) ; Valid
(cell-info (coor 7 7) (contents empty)) ; Invalid - blocked by pawn
(piece (row 8) (column 8) (type pawn) (color white))
(cell-info (coor 8 8) (contents white))) ; Invalid - blocked by pawn
(defrule bishop-moves
(declare (salience 30))
(piece (row ?rb) (column ?cb) (type bishop) (color ?color))
;; The destination cell must be empty or contain
;; an opposing piece
(cell-info (coor ?r ?c) (contents empty | ~?color))
;; If the cell and piece are on the same diagonal, the
;; absolute difference between the two should be the same
(test (= (abs (- ?r ?rb)) (abs (- ?c ?cb))))
;; Check that there is not another piece that is within
;; the rectangle formed by the bishop and the destination
;; cell and is also on the same diagonal as the bishop
(not (and (piece (row ?ro) (column ?co))
(test (and (or (< ?rb ?ro ?r) (< ?r ?ro ?rb))
(or (< ?cb ?co ?c) (< ?c ?co ?cb))))
(test (= (abs (- ?ro ?rb)) (abs (- ?co ?cb))))))
=>
(assert (movement-allowed
(destination-cell ?r ?c)
(type bishop)
(start-cell ?rb ?cb))))