28 aprilie 2010

Fapte si reguli in Clips

; inlocuirea tuturor aparitiilor unui nr cu altul
(deffacts facts (list 1 2 3 2 5) (before 2) (after 10))

(defrule inloc
(before ?x)
(after ?y)
?p<-(list $?a ?b $?c)
(test (eq ?x ?b))
=> (retract ?p)
(assert (list $?a ?y $?c)))

; reuniunea oricator multimi
(deffacts sets (set 1 2 3 4) (set 3 4 5) (set 7 8) (union ))

(defrule reunion
?p<-(set $?a ?b $?c)
?q<-(union $?u)
(test (not (member ?b $?u)))
=> (retract ?q)
(assert (union $?u ?b)))

; intersectia oricator multimi
(deffacts sets (set 1 2 3 4) (set 3 4 5) (set 7 8 3 4))

(defrule init
(not (inter $?x))
?z<-(set $?l)
=> (assert (inter $?l )))

(defrule intersect
?q<-(inter $?a ?b $?c)
?p<-(set $?ll)
(test (not (member ?b $?ll)))
=> (retract ?q)
(assert (inter $?a $?c)))

; toate permutarile unei multimi
(deffacts facts (set 1 2 3))

(defrule perm
?p<-(set $?a ?b ?c $?d)
=> (assert (set $?a ?c ?b $?d)))

; sortarea unei liste folosind bubble sort
(deffacts facts (set 4 7 9 1 2 3))

(defrule sort
?p<-(set $?a ?b $?e ?c $?d)
(test ( > ?b ?c))
=> (retract ?p)
(assert (set $?a ?c $?e ?b $?d)))

; daca un nod este accesibil din alt nod
(deftemplate edge (slot node) (multislot succs))
(deftemplate cale (slot start) (slot stop))

(deffacts varfuri
(edge (node 1) (succs 2 3 4))
(edge (node 2) (succs 1 3))
(edge (node 3) (succs 1 4))
(edge (node 4) (succs )))

(deffacts GAP
(cale (start 2) (stop 4)))
(defrule accesibilitate-directa
(edge (node ?u) (succs $? ?v $?))
=> (assert (accesibil ?u ?v)))

(defrule accesibilitate-indirecta
(accesibil ?u ?z)
(accesibil ?z ?v)
=> (assert (accesibil ?u ?v)))

(defrule solutie
(cale (start ?u) (stop ?v))
(accesibil ?u ?v)
=> (printout t "Da, " ?v " este accesibil din " ?u crlf)
(halt))

;max a doua numere
(deffacts n (numbers 5 17))

(defrule select_max1
(numbers ?x ?y )
(test (> ?x ?y))
=> (assert (maxim ?x)))

(defrule select_max2
(numbers ?x ?y )
(test (<= ?x ?y))
=> (assert (maxim ?y)))
(defrule printmax
(maxim ?n)
=>
(printout t ?n crlf))

;max intre oricate nr
(deffacts numbers
(number 6)
(number -1)
(number 2))

(defrule initmax
(not (maxim ?))
(number ?x)
=> (assert (maxim ?x)))

(defrule comp
(number ?n)
?p <- (maxim ?m)
(test ( < ?m ?n))
=> (retract ?p)
(assert (maxim ?n)))

(defrule printmax
(maxim ?n)
=>
(printout t ?n crlf))

; distanta minima intre 2 noduri, intr-un graf orientat, cu costuri
; aflare dacă un graf e conex
(deftemplate muchie (slot from) (slot to) (slot cost))
(deftemplate cale (slot start) (slot stop))

(deffacts nodes (noduri 1 2 3 4 5 6) (cost_infinit 1000) (ok 0))

(deffacts varfuri
(muchie (from 1) (to 2) (cost 5))
(muchie (from 1) (to 3) (cost 3))
(muchie (from 1) (to 4) (cost 8))
(muchie (from 3) (to 4) (cost 2))
(muchie (from 3) (to 5) (cost 2))
(muchie (from 4) (to 1) (cost 8))
(muchie (from 4) (to 6) (cost 1))
(muchie (from 5) (to 4) (cost 4))
(muchie (from 6) (to 2) (cost 3))
)

(deffacts turneu
(cale (start 1) (stop 6)))

(defrule init
(noduri $? ?x $?)
(noduri $? ?y $?)
(test (not (eq ?x ?y)))
(cost_infinit ?c )
=> (assert (drum ?x ?y ?c))
(assert (drum ?y ?x ?c))
)
(defrule init_arce_directe
(muchie (from ?x) (to ?y) (cost ?c))
?p<-(drum ?x ?y ?cost)
(test (not (eq ?x ?y)))
(cost_infinit ?inf)
(test (eq ?inf ?cost))
=> (retract ?p)
(assert (drum ?x ?y ?c))
)
(defrule drum-min
(drum ?u ?v ?c1)
(drum ?v ?w ?c2)
?p<-(drum ?u ?w ?cost)
(test (> ?cost (+ ?c1 ?c2)))
=> (retract ?p)
(assert (drum ?u ?w (+ ?c1 ?c2))))

(defrule solutie
(cale (start ?u) (stop ?v))
(drum ?u ?v ?cost)
=> (printout t "Costul minim este " ?cost crlf)
(halt))
(defrule conex
(drum ?u ?v ?cost)
(cost_infinit ?inf)
(test (eq ?cost ?inf))
=> (assert (ok ?inf)))

(defrule netareconex
(cost_infinit ?inf)
(ok ?val)
(test (eq ?val ?inf))
=> (assert (ok2 ?inf ))
(printout t "GRAFUL NU este tare conex!!!" crlf) )

(defrule tareconex
(ok ?val)
(test ( < ?val 1))
=> (printout t "cred ca e tare conex" crlf) )

Niciun comentariu: