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>
Related
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))
I need to iterate through a list with sublists in Racket using list iteration and filtering, one of the lists is a nested list, I tried using "list?" and "car" to iterate inside but of course that would only apply to the first value of the sublist.
Is there a way to iterate through the whole nested list using list iteration and filtering?
(define (count-evens lst)
(length
(filter
(lambda (x)
(cond
[(and (list? x)
(and (number? (car x))
(eq? (modulo (car x) 2) 0)))
#t]
[(and (number? x)
(eq? (modulo x 2) 0))
#t]
[else
#f]))
lst)))
(count-evens '(1 2 5 4 (8 4 (b (10 3 3))) 3))
=> 3
Should return => 5
I would use a recursive function to do this but the assignment doesn't allow it.
"...assignment doesn't allow [recursive functions]"
Not sure what is allowed for this assignment, but
in ye olden days we processed recursive data structures with stacks...
(define (count-evens lst)
(define (lst-at stack) ;; (car stack) = index in deepest sub-list
;; produce list cursor within lst indexed by stack
(do ([stack (reverse stack) (cdr stack)]
[cursor (list lst) (list-tail (car cursor) (car stack))])
((null? stack) cursor)))
(do ([stack (list 0)
(cond
[(null? (lst-at stack))
(cdr stack)] ;; pop stack
[(pair? (car (lst-at stack)))
(cons 0 stack)] ;; push stack
[else ;; step through current (sub)list
(cons (+ 1 (car stack)) (cdr stack))])]
[count 0
(let ([item (car (lst-at stack))])
(if (and (number? item) (even? item)) (+ 1 count) count))])
((null? (lst-at stack)) count)))
> (count-evens '(1 2 5 4 (8 4 (b (10 3 3))) 3)) ;=>
5
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)
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>
I am having some trouble here, and hopefully you guys can help.
Basically, what I am trying to do is overload the + sign in racket so that it will add two vectors instead of two numbers. Also, I want to keep the old + operator so that we can still use it. I know this is supposed to work in scheme, so I was told I needed to use module* to do it in racket. I am still not entirely sure how it all works.
Here is what I have so far:
#lang racket
(module* fun scheme/base
(define old+ +)
(define + new+)
(define (new+ x y)
(cond ((and (vector? x) (vector? y))
(quatplus x y))
(else (old+ x y))))
(define (quatplus x y)
(let ((z (make-vector 4)))
(vector-set! z 0 (old+ (vector-ref x 0) (vector-ref y 0)))
(vector-set! z 1 (old+ (vector-ref x 1) (vector-ref y 1)))
(vector-set! z 2 (old+ (vector-ref x 2) (vector-ref y 2)))
(vector-set! z 3 (old+ (vector-ref x 3) (vector-ref y 3)))
z)))
But it doesn't seem to do anything at all. If anyone knows anything about this I would be very appreciative.
Thank you.
How I would do this is to use the except-in and rename-in specs for require:
#lang racket/base
(require (except-in racket + -)
(rename-in racket [+ old+] [- old-]))
(define (+ x y)
(cond [(and (vector? x) (vector? y))
(quatplus x y)]
[else (old+ x y)]))
(define (quatplus x y)
(vector (+ (vector-ref x 0) (vector-ref y 0))
(+ (vector-ref x 1) (vector-ref y 1))
(+ (vector-ref x 2) (vector-ref y 2))
(+ (vector-ref x 3) (vector-ref y 3))))
(+ (vector 1 2 3 4) (vector 1 2 3 4))
;; => #(2 4 6 8)
You could also use prefix-in with only-in, which would be more convenient if you had many such functions to rename:
(require (except-in racket + -)
(prefix-in old (only-in racket + -)))
A few points:
I had quatplus simply return a new immutable vector (instead of using make-vector and set!). It's simpler and probably faster.
Racket's + accepts any number of arguments. Maybe yours should?
As written, your new + will fail for the combination of a non-vector and a vector. You probably want to fix that:
(+ 1 (vector 1 2 3 4))
; +: contract violation
; expected: number?
; given: '#(1 2 3 4)
; argument position: 1st
; other arguments...:
; 1
You can use Scheme encapsulation to accomplish your needs as:
(import (rename (rnrs) (+ numeric+)))
(define +
(let ((vector+ (lambda (v1 v2) (vector-map numeric+ v1 v2)))
(list+ (lambda (l1 l2) (map numeric+ l1 l2)))
;; …
)
(lambda (a b)
(cond ((and (vector? a) (vector? b)) (vector+ a b))
((and (list? a) (list? b)) (list+ a b))
;; …
(else (numeric+ a b))))))
and if you wanted to work the addition to any depth, this should work:
(define +
(letrec ((vector+ (lambda (v1 v2) (vector-map any+ v1 v2)))
(list+ (lambda (l1 l2) (map any+ l1 l2)))
(any+ (lambda (a b)
(cond ((and (vector? a) (vector? b)) (vector+ a b))
((and (list? a) (list? b)) (list+ a b))
;; …
(else (numeric+ a b))))))
any+))
See:
> (+ (vector (list 1 2) 3) (vector (list 11 12) 13))
#((12 14) 16)