(defrule boston-tea-party
	; they dumped the tea into the sea!
	?ship <- (ship ?name boston)
	?route <- (route london boston)
	(cargo ?name tea)
	=>
	(retract ?ship ?route)
	(assert (route hong-kong boston))
)

(defrule set-sail
	?anchor <- (ship ?name ?location)
	?command <- (sail ?name ?destenation)
	(route ?location ?destenation)
	=>
	(retract ?anchor ?command)
	(assert (ship ?name ?destenation))
)

(defrule unload-cargo
	(ship ?name ?location)
	(cargo ?name ?type)
	=>
	(assert (stock ?location ?type))
)

(defrule load-cargo
	(ship ?name ?location)
	(stock ?location ?type)
	=>
	(assert (cargo ?name ?type))
)

(defrule opium-war
	; because East India Company was evil
	(stock hong-kong opium)
	?route <- (route hong-kong ?)
	=>
	(retract ?route)
)

(deffacts  initial-facts
	(ship flying-cloud london)
	(ship hornet london)
	(ship sea-witch hong-kong)
	(route boston hong-kong)
	(route boston london)
	(route london boston)
	(route london hong-kong)
	(route hong-kong london)
	(stock hong-kong tea)
	(stock london opium)
	(stock boston cotton)
)

(defrule boston-tea-party
	; they dumped the tea into the sea!
	?ship <- (ship ?name boston)
	?route <- (route london boston)
	(cargo ?name tea)
	=>
	(retract ?ship ?route)
	(assert (route hong-kong boston))
)

(defrule set-sail
	?anchor <- (ship ?name ?location)
	?command <- (sail ?name ?destination)
	(route ?location ?destination)
	=>
	(retract ?anchor ?command)
	(assert (ship ?name ?destination))
)

(defrule unload-cargo
	(ship ?name ?location)
	(cargo ?name ?type)
	=>
	(assert (stock ?location ?type))
)

(defrule load-cargo
	(ship ?name ?location)
	(stock ?location ?type)
	=>
	(assert (cargo ?name ?type))
)

(defrule opium-war
	; because East India Company was evil
	(stock hong-kong opium)
	?route <- (route hong-kong ?)
	=>
	(retract ?route)
)

(deffacts  initial-facts
	(ship flying-cloud london)
	(ship hornet london)
	(ship sea-witch hong-kong)
	(route boston hong-kong)
	(route boston london)
	(route london boston)
	(route london hong-kong)
	(route hong-kong london)
	(stock hong-kong tea)
	(stock london opium)
	(stock boston cotton)
)

Fix minor typo

Fix minor typo


(deffacts employees
    (employee Lelyakin 10 2 100000)
    (employee Lelyakina 11 2 100000)
    (employee Timkaev 12 3 110000)
    (employee Timkaeva 13 3 110000)
    (employee Kisurin 13 3 111000)
)

(defrule prem
    (employee ?name ?expierence ?children ?salary)

    (test (or (?children > 2)
              (?expierence >= 5)
          )
    )
      =>
    (assert (premia ?name (* ?salary 0.2)))
)

(deffacts employees
    (employee Lelyakin 10 2 100000)
    (employee Lelyakina 11 2 100000)
    (employee Timkaev 12 3 110000)
    (employee Timkaeva 13 3 110000)
    (employee Kisurin 13 3 111000)
    (employee Oldmann 31 3 111991)
)

(defrule prem
    (employee ?name ?expierence ?children ?salary)

    (test (or (> ?children 2)
              (>= ?expierence 5)
          )
    )
      =>
    (assert (premia ?name (* ?salary 0.2)))
)

(defrule all_empl_prem
    (forall (employee ?name ?expierence ?children ?salary)
            (prem ?name))
      =>
    (printout t "All employees has prem")
)

(defrule veteran
    (employee ?name ?expierence ?children ?salary)

    (test (> ?expierence 20))
      =>
    (printout t "There are veterans" crlf)
)

update task1 from chapter4

update task1 from chapter4


(deffunction ask-question (?question $?allowed-values)
    (printout t ?question)
    (bind ?answer (read))

    (if (lexemep ?answer) then
        (bind ?answer (lowcase ?answer)))

    (while (not (member ?answer ?allowed-values)) do
        (printout t ?question)
        (bind ?answer (read))

        (if (lexemep ?answer) then
            (bind ?answer (lowcase ?answer)))
    )

    ?answer
)

(deffunction yes-or-no-p (?question)
    (bind ?response (ask-question ?question yes no у n))
    (or (eq ?response yes) (eq ?response y))
)

Update expert-system.clp

Update expert-system.clp


(deffunction fx (?x ?a)
  (if (< ?x 0) then (return (/ (abs (- ?x ?a)) (* ?x ?x))))
  (if (> ?x 0) then (return (sin (abs (+ ?x ?a)))))
  0
)

Create task4.clp

Create task4.clp


(defrule bank
  =>
  (printout t "p=")
  (bind ?p (read))
  (printout t "You need wait: " (max (round (/ (log 2) (log (+ 1 ?p)))) (round (+ 0.5 (/ (log 2) (log (+ 1 ?p)))))))
)

Create task5.clp

Create task5.clp


(deffunction trim (?str)
    (bind ?str2 "")
    (bind ?space True)
    (bind ?n (str-length ?str))
    (bind ?i 0)
    (while (< ?i ?n) do
        (bind ?c1 (sub-string ?i ?i ?str))

        (if (= 0 (str-compare ?c1 " ")) then
            (if (and (?space True)) then
                (printout t "kefal")
                (bind ?space False)
                (bind ?str2 (str-cat ?str2 ?c1))
            )

        else

            (bind ?space True)
            (bind ?str2 (str-cat ?str2 ?c1))
        )
        (bind ?i (+ ?i 1))
    )
    ?str2
)

Create task5.clp

Create task5.clp


% = MPPD DOMAIN: CLINGCON ENCODING =================================================================

% Move actions
#include "./action-MPP.clp".

% Order fulfillment (Goal condition)
#include "./goal-D-0.clp

% Highway constraints
#include "../control/highways.clp".

% Output conversion
#include "./output-MPPD.lp".

% = MPPD DOMAIN: CLINGCON ENCODING =================================================================

% Move actions
#include "./action-MPP.clp".

% Order fulfillment (Goal condition)
#include "./goal-D-0.clp".

% Highway constraints
#include "../control/highways.clp".

% Output conversion
#include "./output-MPPD.lp".

Fix typo in encoding-0.clp

Fix typo in encoding-0.clp


(deffunction summ-iter (?n)
  (if (= ?n 1) then (return 1))
  (+ (/ 1 (* ?n ?n)) (summ-iter (- ?n 1)))
)

Create task8.clp

Create task8.clp


;;;==========================================================
;;; BeerEX: the Beer EXpert system
;;;
;;;   This expert system suggests a beer to drink with a meal.
;;;
;;;   CLIPS 6.30
;;;
;;;   Author: Donato Meoli
;;;===========================================================

;;**************
;;* DEFGLOBALS *
;;**************

(defglobal
   ?*high-priority* = 1000
   ?*medium-high-priority* = 100
   ?*medium-low-priority* = -100
   ?*low-priority* = -1000)

;;****************
;;* DEFTEMPLATES *
;;****************

(deftemplate UI-state
   (slot id
      (default-dynamic (gensym*)))
   (slot display)
   (slot help)
   (slot why)
   (slot relation-asserted
      (default none))
   (multislot valid-answers)
   (slot response
      (default none))
   (slot state
      (default middle)))

(deftemplate state-list
   (slot current)
   (multislot sequence))

(deftemplate attribute
   (slot name)
   (slot value)
   (slot certainty
      (range -1.0 1.0)
      (default 1.0)))

(deftemplate beer
   (slot style
      (type STRING)
      (allowed-strings "Pale Ale" "Dark Lager" "Brown Ale" "India Pale Ale" "Wheat Beer" "Strong Ale"
                       "Belgian Style" "Hybrid Beer" "Porter" "Stout" "Bock" "Scottish-Style Ale"
                       "Wild/Sour" "Pilsener & Pale Lager" "Specialty Beer"))
   (slot name
      (type STRING))
   (multislot alcohol
      (type SYMBOL)
      (allowed-symbols not-detectable mild noticeable harsh))
   (multislot color
      (type SYMBOL)
      (allowed-symbols pale amber brown dark))
   (multislot flavor
      (type SYMBOL)
      (allowed-symbols crisp-clean malty-sweet dark-roasty hoppy-bitter fruity-spicy sour-tart-funky))
   (multislot fermentation
      (type SYMBOL)
      (allowed-symbols top bottom wild))
   (multislot carbonation
      (type SYMBOL)
      (allowed-symbols low medium high))
   (slot link
      (type STRING)))

;;************
;;* DEFFACTS *
;;************

(deffacts startup
   (state-list))

(defrule load-beer-styles-list
   =>
   (load-facts clips/beer-styles.fct))

;;****************
;;* DEFFUNCTIONS *
;;****************

(deffunction sort-certainties (?attribute1 ?attribute2)
   (< (fact-slot-value ?attribute1 certainty) (fact-slot-value ?attribute2 certainty)))

(deffunction combine-certainty-factors (?x ?y)
   (if (and (> ?x 0) (> ?y 0))
    then (bind ?c (- (+ ?x ?y) (* ?x ?y)))
    else (if (and (< ?x 0) (< ?y 0))
          then (bind ?c (+ (+ ?x ?y) (* ?x ?y)))
          else (bind ?c (/ (+ ?x ?y ) (- 1 (min (abs ?x) (abs ?y)))))))
   ?c)

(deffunction get-explanation ()
   (bind ?explanation (format nil "%s %n%n" "*... for the following reasons:*"))
   (do-for-all-facts ((?a attribute))
                     (eq ?a:name explanation-scenario)
                     (bind ?explanation (str-cat ?explanation ?a:value " ")))
   (do-for-all-facts ((?a attribute))
                     (eq ?a:name explanation-preference)
                     (bind ?explanation (str-cat ?explanation ?a:value " ")))
   (do-for-all-facts ((?a attribute)) (eq ?a:name explanation-main-meal)
                     (bind ?explanation (str-cat ?explanation ?a:value " ")))
   (do-for-all-facts ((?a attribute)) (eq ?a:name explanation-specific-meal)
                     (bind ?explanation (str-cat ?explanation ?a:value " ")))
   ?explanation)

;;*****************
;;* INITIAL STATE *
;;*****************

(defrule start
   =>
   (set-strategy random)
   (assert (UI-state (display (format nil "%n%s %n%n%s %n%n%s" "Welcome to the Beer EXpert system 🍻"
                                          (str-cat "⁉ All I need is that you answer simple questions by choosing "
                                                   "one of the responses that are offered to you.")
                                          "To start, please press the /new button 😄"))
                     (relation-asserted start)
                     (state initial))))

;;***********************
;;* BEER QUESTION RULES *
;;***********************

(defrule load-beer-question-rules
   =>
   (load clips/beer-questions.clp))

;;************************
;;* BEER KNOWLEDGE RULES *
;;************************

(defrule load-beer-knowledge-rules
   =>
   (load clips/beer-knowledge.clp))

;;********************************
;;* BEER SELECTION & PRINT RULES *
;;********************************

(defrule combine-certainties
   ?f1 <- (attribute (name ?name) (value ?value) (certainty ?certainty1))
   ?f2 <- (attribute (name ?name) (value ?value) (certainty ?certainty2))
   (test (neq ?f1 ?f2))
   =>
   (retract ?f1)
   (modify ?f2 (certainty (combine-certainty-factors ?certainty1 ?certainty2))))

(defrule generate-beers
   (declare (salience ?*medium-low-priority*))
   (or (and (beer (style ?beer-style) (name ?beer-name) (link ?link))
            (attribute (name best-style) (value ?beer-style) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (link ?link))
            (attribute (name best-name) (value ?beer-name) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (alcohol $? ?alcohol $?) (link ?link))
            (attribute (name best-alcohol) (value ?alcohol) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (color $? ?color $?) (link ?link))
            (attribute (name best-color) (value ?color) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (flavor $? ?flavor $?) (link ?link))
            (attribute (name best-flavor) (value ?flavor) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (fermentation $? ?fermentation $?) (link ?link))
            (attribute (name best-fermentation) (value ?fermentation) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (carbonation $? ?carbonation $?) (link ?link))
            (attribute (name best-carbonation) (value ?carbonation) (certainty ?certainty))))
   =>
   (assert (attribute (name beer)
                      (value (format nil "🍺 [%s - %s](%s)" ?beer-style ?beer-name ?link))
                      (certainty ?certainty))))

(defrule clean-working-memory-and-print-results
   (declare (salience ?*low-priority*))
   (UI-state (id ?id))
   (state-list (current ?id))
   =>
   (bind ?beers "")
   (bind ?attributes (sort sort-certainties (find-all-facts ((?a attribute)) (eq ?a:name beer))))
   (progn$ (?a ?attributes)
           (if (< (member$ ?a ?attributes) 5)
            then (bind ?beers (str-cat ?beers (format nil "%s with certainty %2d%% %n" (fact-slot-value ?a value)
                                                          (* (fact-slot-value ?a certainty) 100)))))
           (retract ?a))
   (if (neq ?beers "")
    then (bind ?results (str-cat (format nil "%s %n%n%s %n%s" "*✅ Done. I have selected these beer styles for you...*"
                                             ?beers (get-explanation))))
    else (bind ?results (format nil "%s %n%n%s" "*🚫 Sorry! I could not select any beer style for you. 😞"
                                                "Please, try again! 💪🏻*")))
   (do-for-all-facts ((?a attribute)) TRUE (retract ?a))
   (assert (UI-state (display ?results)
                     (state final))))

;;*************************
;;* GUI INTERACTION RULES *
;;*************************

(defrule ask-question
   (declare (salience ?*medium-high-priority*))
   (UI-state (id ?id))
   ?f <- (state-list (sequence $?s&:(not (member$ ?id ?s))))
   =>
   (modify ?f (current ?id) (sequence ?id ?s))
   (halt))

(defrule handle-next-no-change-none-middle-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id)
   ?f2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   =>
   (retract ?f1)
   (modify ?f2 (current ?nid))
   (halt))

(defrule handle-next-response-none-end-of-chain
   (declare (salience ?*high-priority*))
   ?f <- (next ?id)
   (state-list (sequence ?id $?))
   (UI-state (id ?id) (relation-asserted ?relation))
   =>
   (retract ?f)
   (assert (add-response ?id)))

(defrule handle-next-no-change-middle-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id ?response)
   ?f2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   (UI-state (id ?id) (response ?response))
   =>
   (retract ?f1)
   (modify ?f2 (current ?nid))
   (halt))

(defrule handle-next-change-middle-of-chain
   (declare (salience ?*high-priority*))
   (next ?id ?response)
   ?f1 <- (state-list (current ?id) (sequence ?nid $?b ?id $?e))
   (UI-state (id ?id) (response ~?response))
   ?f2 <- (UI-state (id ?nid))
   =>
   (modify ?f1 (sequence ?b ?id ?e))
   (retract ?f2))

(defrule handle-next-response-end-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id ?response)
   (state-list (sequence ?id $?))
   ?f2 <- (UI-state (id ?id) (response ?expected) (relation-asserted ?relation))
   =>
   (retract ?f1)
   (if (neq ?response ?expected)
    then (modify ?f2 (response ?response)))
   (assert (add-response ?id ?response)))

(defrule handle-add-response
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?f <- (add-response ?id ?response)
   =>
   (if (eq (str-index " " ?response) FALSE)
    then (str-assert (str-cat "(" ?relation " " ?response ")"))
    else (str-assert (str-cat "(" ?relation " " "\"" ?response "\"" ")")))
   (retract ?f))

(defrule handle-add-response-none
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?f <- (add-response ?id)
   =>
   (str-assert (str-cat "(" ?relation ")"))
   (retract ?f))

(defrule handle-prev
   (declare (salience ?*high-priority*))
   ?f1 <- (prev ?id)
   (UI-state (id ?id) (state ?state))
   ?f2 <- (state-list (sequence $?b ?id ?pid $?e))
   (UI-state (id ?pid) (relation-asserted ?relation))
   =>
   (retract ?f1)
   (modify ?f2 (current ?pid))
   (do-for-fact ((?r ?relation)) (neq ?relation start) (retract ?r))
   (if (eq (get-strategy) random)
    then (progn$ (?rule (get-defrule-list))
                 (if (neq (str-index "random-question" ?rule) FALSE)
                  then (refresh ?rule))))
   (if (eq ?state final)
    then (progn$ (?rule (get-defrule-list))
                 (if (neq (str-index "determine-best-beer-attributes" ?rule) FALSE)
                  then (refresh ?rule))))
   (halt))

;;;===============================================
;;; BeerEX: the Beer EXpert system
;;;
;;;   This expert system suggests a beer to drink.
;;;
;;;   CLIPS 6.30
;;;
;;;   Author: Donato Meoli
;;;===============================================

;;**************
;;* DEFGLOBALS *
;;**************

(defglobal
   ?*high-priority* = 1000
   ?*medium-high-priority* = 100
   ?*medium-low-priority* = -100
   ?*low-priority* = -1000)

;;****************
;;* DEFTEMPLATES *
;;****************

(deftemplate UI-state
   (slot id
      (default-dynamic (gensym*)))
   (slot display)
   (slot help)
   (slot why)
   (slot relation-asserted
      (default none))
   (multislot valid-answers)
   (slot response
      (default none))
   (slot state
      (default middle)))

(deftemplate state-list
   (slot current)
   (multislot sequence))

(deftemplate attribute
   (slot name)
   (slot value)
   (slot certainty
      (range -1.0 1.0)
      (default 1.0)))

(deftemplate beer
   (slot style
      (type STRING)
      (allowed-strings "Pale Ale" "Dark Lager" "Brown Ale" "India Pale Ale" "Wheat Beer" "Strong Ale"
                       "Belgian Style" "Hybrid Beer" "Porter" "Stout" "Bock" "Scottish-Style Ale"
                       "Wild/Sour" "Pilsener & Pale Lager" "Specialty Beer"))
   (slot name
      (type STRING))
   (multislot alcohol
      (type SYMBOL)
      (allowed-symbols not-detectable mild noticeable harsh))
   (multislot color
      (type SYMBOL)
      (allowed-symbols pale amber brown dark))
   (multislot flavor
      (type SYMBOL)
      (allowed-symbols crisp-clean malty-sweet dark-roasty hoppy-bitter fruity-spicy sour-tart-funky))
   (multislot fermentation
      (type SYMBOL)
      (allowed-symbols top bottom wild))
   (multislot carbonation
      (type SYMBOL)
      (allowed-symbols low medium high))
   (slot link
      (type STRING)))

;;************
;;* DEFFACTS *
;;************

(deffacts startup
   (state-list))

(defrule load-beer-styles-list
   =>
   (load-facts clips/beer-styles.fct))

;;****************
;;* DEFFUNCTIONS *
;;****************

(deffunction sort-certainties (?attribute1 ?attribute2)
   (< (fact-slot-value ?attribute1 certainty) (fact-slot-value ?attribute2 certainty)))

(deffunction combine-certainty-factors (?x ?y)
   (if (and (> ?x 0) (> ?y 0))
    then (bind ?c (- (+ ?x ?y) (* ?x ?y)))
    else (if (and (< ?x 0) (< ?y 0))
          then (bind ?c (+ (+ ?x ?y) (* ?x ?y)))
          else (bind ?c (/ (+ ?x ?y ) (- 1 (min (abs ?x) (abs ?y)))))))
   ?c)

(deffunction get-explanation ()
   (bind ?explanation (format nil "%s %n%n" "*... for the following reasons:*"))
   (do-for-all-facts ((?a attribute))
                     (eq ?a:name explanation-scenario)
                     (bind ?explanation (str-cat ?explanation ?a:value " ")))
   (do-for-all-facts ((?a attribute))
                     (eq ?a:name explanation-preference)
                     (bind ?explanation (str-cat ?explanation ?a:value " ")))
   (do-for-all-facts ((?a attribute)) (eq ?a:name explanation-main-meal)
                     (bind ?explanation (str-cat ?explanation ?a:value " ")))
   (do-for-all-facts ((?a attribute)) (eq ?a:name explanation-specific-meal)
                     (bind ?explanation (str-cat ?explanation ?a:value " ")))
   ?explanation)

;;*****************
;;* INITIAL STATE *
;;*****************

(defrule start
   =>
   (set-strategy random)
   (assert (UI-state (display (format nil "%n%s %n%n%s %n%n%s" "Welcome to the Beer EXpert system 🍻"
                                          (str-cat "⁉ All I need is that you answer simple questions by choosing "
                                                   "one of the responses that are offered to you.")
                                          "To start, please press the /new button 😄"))
                     (relation-asserted start)
                     (state initial))))

;;***********************
;;* BEER QUESTION RULES *
;;***********************

(defrule load-beer-question-rules
   =>
   (load clips/beer-questions.clp))

;;************************
;;* BEER KNOWLEDGE RULES *
;;************************

(defrule load-beer-knowledge-rules
   =>
   (load clips/beer-knowledge.clp))

;;********************************
;;* BEER SELECTION & PRINT RULES *
;;********************************

(defrule combine-certainties
   ?f1 <- (attribute (name ?name) (value ?value) (certainty ?certainty1))
   ?f2 <- (attribute (name ?name) (value ?value) (certainty ?certainty2))
   (test (neq ?f1 ?f2))
   =>
   (retract ?f1)
   (modify ?f2 (certainty (combine-certainty-factors ?certainty1 ?certainty2))))

(defrule generate-beers
   (declare (salience ?*medium-low-priority*))
   (or (and (beer (style ?beer-style) (name ?beer-name) (link ?link))
            (attribute (name best-style) (value ?beer-style) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (link ?link))
            (attribute (name best-name) (value ?beer-name) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (alcohol $? ?alcohol $?) (link ?link))
            (attribute (name best-alcohol) (value ?alcohol) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (color $? ?color $?) (link ?link))
            (attribute (name best-color) (value ?color) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (flavor $? ?flavor $?) (link ?link))
            (attribute (name best-flavor) (value ?flavor) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (fermentation $? ?fermentation $?) (link ?link))
            (attribute (name best-fermentation) (value ?fermentation) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (carbonation $? ?carbonation $?) (link ?link))
            (attribute (name best-carbonation) (value ?carbonation) (certainty ?certainty))))
   =>
   (assert (attribute (name beer)
                      (value (format nil "🍺 [%s - %s](%s)" ?beer-style ?beer-name ?link))
                      (certainty ?certainty))))

(defrule clean-working-memory-and-print-results
   (declare (salience ?*low-priority*))
   (UI-state (id ?id))
   (state-list (current ?id))
   =>
   (bind ?beers "")
   (bind ?attributes (sort sort-certainties (find-all-facts ((?a attribute)) (eq ?a:name beer))))
   (progn$ (?a ?attributes)
           (if (< (member$ ?a ?attributes) 5)
            then (bind ?beers (str-cat ?beers (format nil "%s with certainty %2d%% %n" (fact-slot-value ?a value)
                                                          (* (fact-slot-value ?a certainty) 100)))))
           (retract ?a))
   (if (neq ?beers "")
    then (bind ?results (str-cat (format nil "%s %n%n%s %n%s" "*✅ Done. I have selected these beer styles for you...*"
                                             ?beers (get-explanation))))
    else (bind ?results (format nil "%s %n%n%s" "*🚫 Sorry! I could not select any beer style for you. 😞"
                                                "Please, try again! 💪🏻*")))
   (do-for-all-facts ((?a attribute)) TRUE (retract ?a))
   (assert (UI-state (display ?results)
                     (state final))))

;;*************************
;;* GUI INTERACTION RULES *
;;*************************

(defrule ask-question
   (declare (salience ?*medium-high-priority*))
   (UI-state (id ?id))
   ?f <- (state-list (sequence $?s&:(not (member$ ?id ?s))))
   =>
   (modify ?f (current ?id) (sequence ?id ?s))
   (halt))

(defrule handle-next-no-change-none-middle-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id)
   ?f2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   =>
   (retract ?f1)
   (modify ?f2 (current ?nid))
   (halt))

(defrule handle-next-response-none-end-of-chain
   (declare (salience ?*high-priority*))
   ?f <- (next ?id)
   (state-list (sequence ?id $?))
   (UI-state (id ?id) (relation-asserted ?relation))
   =>
   (retract ?f)
   (assert (add-response ?id)))

(defrule handle-next-no-change-middle-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id ?response)
   ?f2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   (UI-state (id ?id) (response ?response))
   =>
   (retract ?f1)
   (modify ?f2 (current ?nid))
   (halt))

(defrule handle-next-change-middle-of-chain
   (declare (salience ?*high-priority*))
   (next ?id ?response)
   ?f1 <- (state-list (current ?id) (sequence ?nid $?b ?id $?e))
   (UI-state (id ?id) (response ~?response))
   ?f2 <- (UI-state (id ?nid))
   =>
   (modify ?f1 (sequence ?b ?id ?e))
   (retract ?f2))

(defrule handle-next-response-end-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id ?response)
   (state-list (sequence ?id $?))
   ?f2 <- (UI-state (id ?id) (response ?expected) (relation-asserted ?relation))
   =>
   (retract ?f1)
   (if (neq ?response ?expected)
    then (modify ?f2 (response ?response)))
   (assert (add-response ?id ?response)))

(defrule handle-add-response
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?f <- (add-response ?id ?response)
   =>
   (if (eq (str-index " " ?response) FALSE)
    then (str-assert (str-cat "(" ?relation " " ?response ")"))
    else (str-assert (str-cat "(" ?relation " " "\"" ?response "\"" ")")))
   (retract ?f))

(defrule handle-add-response-none
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?f <- (add-response ?id)
   =>
   (str-assert (str-cat "(" ?relation ")"))
   (retract ?f))

(defrule handle-prev
   (declare (salience ?*high-priority*))
   ?f1 <- (prev ?id)
   (UI-state (id ?id) (state ?state))
   ?f2 <- (state-list (sequence $?b ?id ?pid $?e))
   (UI-state (id ?pid) (relation-asserted ?relation))
   =>
   (retract ?f1)
   (modify ?f2 (current ?pid))
   (do-for-fact ((?r ?relation)) (neq ?relation start) (retract ?r))
   (if (eq (get-strategy) random)
    then (progn$ (?rule (get-defrule-list))
                 (if (neq (str-index "random-question" ?rule) FALSE)
                  then (refresh ?rule))))
   (if (eq ?state final)
    then (progn$ (?rule (get-defrule-list))
                 (if (neq (str-index "determine-best-beer-attributes" ?rule) FALSE)
                  then (refresh ?rule))))
   (halt))

update beerex.clp

update beerex.clp


(defrule ask-question
   (declare (salience ?*medium-high-priority*))
   (UI-state (id ?id))
   ?fact <- (state-list (sequence $?s&:(not (member$ ?id ?s))))
   =>
   (modify ?fact (current ?id) (sequence ?id ?s))
   (halt))

(defrule handle-next-no-change-none-middle-of-chain
   (declare (salience ?*high-priority*))
   ?fact1 <- (next ?id)
   ?fact2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   =>
   (retract ?fact1)
   (modify ?fact2 (current ?nid))
   (halt))

(defrule handle-next-response-none-end-of-chain
   (declare (salience ?*high-priority*))
   ?fact <- (next ?id)
   (state-list (sequence ?id $?))
   (UI-state (id ?id) (relation-asserted ?relation))
   =>
   (retract ?fact)
   (assert (add-response ?id)))

(defrule handle-next-no-change-middle-of-chain
   (declare (salience ?*high-priority*))
   ?fact1 <- (next ?id ?response)
   ?fact2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   (UI-state (id ?id) (response ?response))
   =>
   (retract ?fact1)
   (modify ?fact2 (current ?nid))
   (halt))

(defrule handle-next-change-middle-of-chain
   (declare (salience ?*high-priority*))
   (next ?id ?response)
   ?fact1 <- (state-list (current ?id) (sequence ?nid $?b ?id $?e))
   (UI-state (id ?id) (response ~?response))
   ?fact2 <- (UI-state (id ?nid))
   =>
   (modify ?fact1 (sequence ?b ?id ?e))
   (retract ?fact2))

(defrule handle-next-response-end-of-chain
   (declare (salience ?*high-priority*))
   ?fact1 <- (next ?id ?response)
   (state-list (sequence ?id $?))
   ?fact2 <- (UI-state (id ?id) (response ?expected) (relation-asserted ?relation))
   =>
   (retract ?fact1)
   (if (neq ?response ?expected)
    then (modify ?fact2 (response ?response)))
   (assert (add-response ?id ?response)))

(defrule handle-add-response
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?fact <- (add-response ?id ?response)
   =>
   (if (eq (str-index " " ?response) FALSE)
    then (str-assert (str-cat "(" ?relation " " ?response ")"))
    else (str-assert (str-cat "(" ?relation " " "\"" ?response "\"" ")")))
   (retract ?fact))

(defrule handle-add-response-none
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?fact <- (add-response ?id)
   =>
   (str-assert (str-cat "(" ?relation ")"))
   (retract ?fact))

(defrule handle-prev
   (declare (salience ?*high-priority*))
   ?fact1 <- (prev ?id)
   ?fact2 <- (state-list (sequence $?b ?id ?pid $?e))
   (UI-state (id ?pid) (relation-asserted ?relation))
   =>
   (retract ?fact1)
   (modify ?fact2 (current ?pid))
   (do-for-fact ((?f ?relation)) (neq ?relation start) (retract ?f))
   (halt))

(defrule ask-question
   (declare (salience ?*medium-high-priority*))
   (UI-state (id ?id))
   ?fact <- (state-list (sequence $?s&:(not (member$ ?id ?s))))
   =>
   (modify ?fact (current ?id) (sequence ?id ?s))
   (halt))

(defrule handle-next-no-change-none-middle-of-chain
   (declare (salience ?*high-priority*))
   ?fact1 <- (next ?id)
   ?fact2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   =>
   (retract ?fact1)
   (modify ?fact2 (current ?nid))
   (halt))

(defrule handle-next-response-none-end-of-chain
   (declare (salience ?*high-priority*))
   ?fact <- (next ?id)
   (state-list (sequence ?id $?))
   (UI-state (id ?id) (relation-asserted ?relation))
   =>
   (retract ?fact)
   (assert (add-response ?id)))

(defrule handle-next-no-change-middle-of-chain
   (declare (salience ?*high-priority*))
   ?fact1 <- (next ?id ?response)
   ?fact2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   (UI-state (id ?id) (response ?response))
   =>
   (retract ?fact1)
   (modify ?fact2 (current ?nid))
   (halt))

(defrule handle-next-change-middle-of-chain
   (declare (salience ?*high-priority*))
   (next ?id ?response)
   ?fact1 <- (state-list (current ?id) (sequence ?nid $?b ?id $?e))
   (UI-state (id ?id) (response ~?response))
   ?fact2 <- (UI-state (id ?nid))
   =>
   (modify ?fact1 (sequence ?b ?id ?e))
   (retract ?fact2))

(defrule handle-next-response-end-of-chain
   (declare (salience ?*high-priority*))
   ?fact1 <- (next ?id ?response)
   (state-list (sequence ?id $?))
   ?fact2 <- (UI-state (id ?id) (response ?expected) (relation-asserted ?relation))
   =>
   (retract ?fact1)
   (if (neq ?response ?expected)
    then (modify ?fact2 (response ?response)))
   (assert (add-response ?id ?response)))

(defrule handle-add-response
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?fact <- (add-response ?id ?response)
   =>
   (if (eq (str-index " " ?response) FALSE)
    then (str-assert (str-cat "(" ?relation " " ?response ")"))
    else (str-assert (str-cat "(" ?relation " " "\"" ?response "\"" ")")))
   (retract ?fact))

(defrule handle-add-response-none
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?fact <- (add-response ?id)
   =>
   (str-assert (str-cat "(" ?relation ")"))
   (retract ?fact))

(defrule handle-prev
   (declare (salience ?*high-priority*))
   ?fact1 <- (prev ?id)
   ?fact2 <- (state-list (sequence $?b ?id ?pid $?e))
   (UI-state (id ?pid) (relation-asserted ?relation))
   =>
   (retract ?fact1)
   (modify ?fact2 (current ?pid))
   (do-for-fact ((?f ?relation)) (neq ?relation start) (retract ?f))
   (do-for-all-facts ((?u UI-state) (?s state-list)) (not (member$ ?u:id ?s:sequence)) (retract ?u))
   (halt))

update BeerEX.bot.py

update BeerEX.bot.py


// First task
(deffacts students
         (student LelyakinMA 4)
         (student ArutunyaAS 4)
         (student KefalicsAI 1)
         (student BelokobylskySA 2)
)

(facts)

(retract 2)
(retract 3)

(assert (student KefalicsAI 2))

(facts)

// First task
// Students
(deffacts students
         (student LelyakinMA 4)
         (student ArutunyaAS 4)
         (student KefalicsAI 1)
         (student BelokobylskySA 2)
)

(facts)

(retract 2)
(retract 3)

(assert (student KefalicsAI 2))

(facts)

// Trains
(deffacts trains
          (train 11 Saratov 11)
          (train 22 Engels 21)
          (train 33 Kazan 22)
)

(assert (train 44 Samara 10))
(assert (train 55 Volgograd 08))

(retract 1 4)

(retract 2 3)

(assert (train 22 Moscow 01))
(assert (train 33 Kazan 00))

// Employees
(assert (sotrudnik LelyakinMA 1)
        (sotrudnik GerasimovVD 2)
        (sotrudnik VonnegutKG 3)
        (sotrudnik PushkinAS 3)
)

(retract 1)

(retract 3)
(assert (sotrudnik VasilevKD 3))

// Products
(assert (IceCream Russia 10 1)
		(ApelsineJuce Russia 20 2)
		(WaterMelone Russia 30 3)
		(Liberty USA 1000 99)
)

(facts)

(retract 2)
(ApelsineJuce Russia 19 2)

(retract 4)
(Liberty USA 0 99)

Add chapter 2 tasks

Add chapter 2 tasks


Create task7.clp

Create task7.clp


(deffunction ask-question (?question $?allowed-values)
    (printout t ?question)
    (bind ?answer (read))

    (if (lexemep ?answer) then
        (bind ?answer (lowcase ?answer)))

    (while (not (member ?answer ?allowed-values)) do
        (printout t ?question)
        (bind ?answer (read))

        (if (lexemep ?answer) then
            (bind ?answer (lowcase ?answer)))
    )

    ?answer
)

Create expert-system.clp

Create expert-system.clp


(deffunction str-del (?substr ?str)
    (bind ?n1 (str-length ?substr))
    (bind ?n2 (str-length ?str))
    (bind ?k (str-index ?substr ?str))
    (while (> ?k 0) do
        (bind ?st1 (sub-string 1 (- ?k 1) ?str))
        (bind ?st2 (sub-string (+ ?k ?n1) ?n2 ?str))
        (bind ?str (str-cat ?st1 ?st2))
        (bind ?k (str-index ?substr ?str))
        (if (not ?k) then
            (bind ?k 0)
        )
    )
    ?str)

(defrule substr_delete
=>
(bind ?str (read))
(bind ?substr (read))
(bind ?str (str-del ?substr ?str))
(printout t "str=" ?str crlf))

Update task3.clp

Update task3.clp


; sample test

(clear)
(defclass DUCK (is-a USER)
    (slot age (default 1))
    (multislot sound (default quack quack))
)

(defrule find-sound
    ?duck <- (object
        (is-a DUCK)
        (sound $?find))
  =>
    (printout t "Duck " (instance-name ?duck) " says " ?find crlf)
)

(defrule find-dorky-sound
    (object
        (is-a DUCK)
        (sound $?find)
        (name [Dorky_Duck]))
    =>
    (printout t "[Dorky_Duck] sound" crlf)
)

(make-instance [Dorky_Duck] of DUCK)
(make-instance [Dinky_Duck] of DUCK)

(instances)

(agenda)
(run)

(defrule find-age-over-10
    ?duck <- (object
        (is-a DUCK)
        (age ?age &:(> ?age 10)))
  =>
    (printout t "Duck-1 " (instance-name ?duck) " age " ?age crlf)
)

(defrule find-age-over-20-or-below-10
    ?duck <- (object
        (is-a DUCK)
        (age ?age &:(> ?age 20)|:(< ?age 10)))
  =>
    (printout t "Duck-2 " (instance-name ?duck) " age " ?age crlf)
)

(defrule find-name-is-unkown-or-name-is-dinky
    (or
        (object
            (is-a DUCK)
            (age 30)
        )

        (object
            (is-a DUCK)
            (name [Dinky_Duck])
        )
    )
    ?f <- (make-again 1)
  =>
    (retract ?f)
    (printout t "Duck-3 " crlf)
)

(send [Dinky_Duck] put-age 30)
(assert (make-again 1))
(send [Dinky_Duck] print)

(instances)

(agenda)
(run)
(agenda)

(assert (make-again 1))
(facts)
(instances)
(agenda)

(exit)

; sample test

(clear)
(defclass DUCK (is-a USER)
    (slot age (default 1))
    (multislot sound (default quack quack))
)

(defrule find-sound
    ?duck <- (object
        (is-a DUCK)
        (sound $?find))
  =>
    (printout t "Duck " (instance-name ?duck) " says " ?find crlf)
)

(defrule find-dorky-sound
    (object
        (is-a DUCK)
        (sound $?find)
        (name [Dorky_Duck]))
    =>
    (printout t "[Dorky_Duck] sound" crlf)
)

(make-instance [Dorky_Duck] of DUCK)
(make-instance [Dinky_Duck] of DUCK)

(instances)

(agenda)
(run)

(defrule find-age-over-10
    ?duck <- (object
        (is-a DUCK)
        (age ?age &:(> ?age 10)))
  =>
    (printout t "Duck-1 " (instance-name ?duck) " age " ?age crlf)
)

(defrule find-age-over-20-or-below-10
    ?duck <- (object
        (is-a DUCK)
        (age ?age &:(> ?age 20)|:(< ?age 10)))
  =>
    (printout t "Duck-2 " (instance-name ?duck) " age " ?age crlf)
)

(defrule find-age-over-10-and-below-20
    ?duck <- (object
        (is-a DUCK)
        (age ?age &:(> ?age 10)&:(< ?age 20)))
  =>
    (printout t "Duck-3 " (instance-name ?duck) " age " ?age crlf)
)

(defrule find-name-is-unkown-or-name-is-dinky
    (or
        (object
            (is-a DUCK)
            (age 30)
        )

        (object
            (is-a DUCK)
            (name [Dinky_Duck])
        )
    )
    ?f <- (make-again 1)
  =>
    (retract ?f)
    (printout t "Duck-3 " crlf)
)

; (send [Dinky_Duck] put-age 30)
; (assert (make-again 1))
; (send [Dinky_Duck] print)
;
(instances)

(send [Dinky_Duck] print)
(send [Dorky_Duck] print)
(send [Dinky_Duck] put-age 25)
(send [Dinky_Duck] put-age 15)
(agenda)
(run)

; (agenda)
; (run)
; (agenda)
;
; (assert (make-again 1))
; (facts)
; (instances)
; (agenda)

(exit)

add and sample

add and sample


(deffunction str-del (?substr ?str)
    (bind ?n1 (str-length ?substr))
    (bind ?n2 (str-length ?str))
    (bind ?k (str-index ?substr ?str))
    (while (> ?k 0) do
        (bind ?st1 (sub-string 1 (- ?k 1) ?str))
        (bind ?st2 (sub-string (+ ?k ?n1) ?n2 ?str))
        (bind ?str (str-cat ?st1 ?st2))
        (bind ?k (str-index ?substr ?str))
        (if (not ?k) then
            (bind ?k 0)
        )
    )
    ?str)

Create task3.clp

Create task3.clp


(deffunction summ-iter (?n)
  (if (= ?n 1) then (return 1))
  (+ (/ 1 ?n) (summ-iter (- ?n 1)))
)

Create task6.clp

Create task6.clp


;;;==========================================================
;;; BeerEX: the Beer EXpert system
;;;
;;;   This expert system suggests a beer to drink with a meal.
;;;
;;;   CLIPS 6.30
;;;
;;;   Author: Donato Meoli
;;;===========================================================

;;**************
;;* DEFGLOBALS *
;;**************

(defglobal
   ?*high-priority* = 1000
   ?*medium-high-priority* = 100
   ?*medium-low-priority* = -100
   ?*low-priority* = -1000)

;;****************
;;* DEFTEMPLATES *
;;****************

(deftemplate UI-state
   (slot id
      (default-dynamic (gensym*)))
   (slot display)
   (slot help)
   (slot why)
   (slot relation-asserted
      (default none))
   (multislot valid-answers)
   (slot response
      (default none))
   (slot state
      (default middle)))

(deftemplate state-list
   (slot current)
   (multislot sequence))

(deftemplate attribute
   (slot name)
   (slot value)
   (slot certainty
      (default 100.0)))

(deftemplate beer
   (slot style
      (type STRING)
      (allowed-strings "Pale Ale" "Dark Lager" "Brown Ale" "India Pale Ale" "Wheat Beer" "Strong Ale"
                       "Belgian Style" "Hybrid Beer" "Porter" "Stout" "Bock" "Scottish-Style Ale"
                       "Wild/Sour" "Pilsener & Pale Lager" "Specialty Beer"))
   (slot name
      (type STRING))
   (multislot alcohol
      (type SYMBOL)
      (allowed-symbols not-detectable mild noticeable harsh))
   (multislot color
      (type SYMBOL)
      (allowed-symbols pale amber brown dark))
   (multislot flavor
      (type SYMBOL)
      (allowed-symbols crisp-clean malty-sweet dark-roasty hoppy-bitter fruity-spicy sour-tart-funky))
   (multislot fermentation
      (type SYMBOL)
      (allowed-symbols top bottom wild))
   (multislot carbonation
      (type SYMBOL)
      (allowed-symbols low medium high))
   (slot link
      (type STRING)))

;;************
;;* DEFFACTS *
;;************

(deffacts startup
   (state-list))

(defrule load-beer-styles-list
  =>
  (load-facts clips/beer-styles.fct))

;;****************
;;* DEFFUNCTIONS *
;;****************

(deffunction sort-certainties (?a1 ?a2)
   (< (fact-slot-value ?a1 certainty) (fact-slot-value ?a2 certainty)))

;;*****************
;;* INITIAL STATE *
;;*****************

(defrule start
  =>
  (set-strategy random)
  (assert (UI-state (display (format nil "%n%s %n%n%s %n%n%s" "Welcome to the Beer EXpert system 🍻"
                                         (str-cat "⁉ All I need is that you answer simple questions by choosing "
                                                  "one of the responses that are offered to you.")
                                         "To start, please press the /new button 😄"))
                    (relation-asserted start)
                    (state initial))))

;;***********************
;;* BEER QUESTION RULES *
;;***********************

(defrule load-beer-question-rules
   =>
   (load clips/beer-questions.clp))

;;************************
;;* BEER KNOWLEDGE RULES *
;;************************

(defrule load-beer-knowledge-rules
   =>
   (load clips/beer-knowledge.clp))

;;********************************
;;* BEER SELECTION & PRINT RULES *
;;********************************

(defrule combine-certainties
   ?f1 <- (attribute (name ?name) (value ?value) (certainty ?certainty1))
   ?f2 <- (attribute (name ?name) (value ?value) (certainty ?certainty2))
   (test (neq ?f1 ?f2))
   =>
   (retract ?f1)
   (modify ?f2 (certainty (/ (- (* (+ ?certainty1 ?certainty2) 100) (* ?certainty1 ?certainty2)) 100))))

(defrule generate-beers
   (declare (salience ?*medium-low-priority*))
   (or (and (beer (style ?beer-style) (name ?beer-name) (link ?link))
            (attribute (name best-style) (value ?beer-style) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (link ?link))
            (attribute (name best-name) (value ?beer-name) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (alcohol $? ?alcohol $?) (link ?link))
            (attribute (name best-alcohol) (value ?alcohol) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (color $? ?color $?) (link ?link))
            (attribute (name best-color) (value ?color) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (flavor $? ?flavor $?) (link ?link))
            (attribute (name best-flavor) (value ?flavor) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (fermentation $? ?fermentation $?) (link ?link))
            (attribute (name best-fermentation) (value ?fermentation) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (carbonation $? ?carbonation $?) (link ?link))
            (attribute (name best-carbonation) (value ?carbonation) (certainty ?certainty))))
   =>
   (assert (attribute (name beer)
                      (value (format nil "🍺 [%s - %s](%s)" ?beer-style ?beer-name ?link))
                      (certainty ?certainty))))

(defrule remove-poor-beer-choices
   ?f <- (attribute (name beer) (certainty ?certainty&:(< ?certainty 50)))
   =>
   (retract ?f))

(defrule print-results
   (declare (salience ?*medium-low-priority*))
   (UI-state (id ?id))
   (state-list (current ?id))
   =>
   (do-for-all-facts ((?a attribute)) (neq ?a:name beer) (retract ?a))
   (bind ?beers "")
   (bind ?attributes (find-all-facts ((?a attribute)) (eq ?a:name beer)))
   (bind ?attributes (sort sort-certainties ?attributes))
   (progn$ (?a ?attributes)
           (bind ?beers (str-cat ?beers (format nil "%s with certainty %-2d%% %n"
                                                    (fact-slot-value ?a value) (fact-slot-value ?a certainty))))
           (retract ?a))
   (if (neq ?beers "")
    then (bind ?results (str-cat (format nil "%s %n%n" "*✅ Done. I have selected these beer styles for you.*") ?beers))
    else (bind ?results (format nil "%s %n%n%s" "*🚫 Sorry! I could not select any beer style for you. 😞"
                                                "Please, try again! 💪🏻*")))
   (assert (UI-state (display ?results)
                     (state final))))

;;*************************
;;* GUI INTERACTION RULES *
;;*************************

(defrule ask-question
   (declare (salience ?*medium-high-priority*))
   (UI-state (id ?id))
   ?f <- (state-list (sequence $?s&:(not (member$ ?id ?s))))
   =>
   (modify ?f (current ?id) (sequence ?id ?s))
   (halt))

(defrule handle-next-no-change-none-middle-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id)
   ?f2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   =>
   (retract ?f1)
   (modify ?f2 (current ?nid))
   (halt))

(defrule handle-next-response-none-end-of-chain
   (declare (salience ?*high-priority*))
   ?f <- (next ?id)
   (state-list (sequence ?id $?))
   (UI-state (id ?id) (relation-asserted ?relation))
   =>
   (retract ?f)
   (assert (add-response ?id)))

(defrule handle-next-no-change-middle-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id ?response)
   ?f2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   (UI-state (id ?id) (response ?response))
   =>
   (retract ?f1)
   (modify ?f2 (current ?nid))
   (halt))

(defrule handle-next-change-middle-of-chain
   (declare (salience ?*high-priority*))
   (next ?id ?response)
   ?f1 <- (state-list (current ?id) (sequence ?nid $?b ?id $?e))
   (UI-state (id ?id) (response ~?response))
   ?f2 <- (UI-state (id ?nid))
   =>
   (modify ?f1 (sequence ?b ?id ?e))
   (retract ?f2))

(defrule handle-next-response-end-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id ?response)
   (state-list (sequence ?id $?))
   ?f2 <- (UI-state (id ?id) (response ?expected) (relation-asserted ?relation))
   =>
   (retract ?f1)
   (if (neq ?response ?expected)
    then (modify ?f2 (response ?response)))
   (assert (add-response ?id ?response)))

(defrule handle-add-response
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?f <- (add-response ?id ?response)
   =>
   (if (eq (str-index " " ?response) FALSE)
    then (str-assert (str-cat "(" ?relation " " ?response ")"))
    else (str-assert (str-cat "(" ?relation " " "\"" ?response "\"" ")")))
   (retract ?f))

(defrule handle-add-response-none
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?f <- (add-response ?id)
   =>
   (str-assert (str-cat "(" ?relation ")"))
   (retract ?f))

(defrule handle-prev
   (declare (salience ?*high-priority*))
   ?f1 <- (prev ?id)
   (UI-state (id ?id) (state ?state))
   ?f2 <- (state-list (sequence $?b ?id ?pid $?e))
   (UI-state (id ?pid) (relation-asserted ?relation))
   =>
   (retract ?f1)
   (modify ?f2 (current ?pid))
   (do-for-fact ((?r ?relation)) (neq ?relation start) (retract ?r))
   (if (eq ?state final)
    then (progn$ (?rule (get-defrule-list))
                 (if (neq (str-index "determine-best-beer-attributes" ?rule) FALSE)
                  then (refresh ?rule))))
   (halt))

;;;==========================================================
;;; BeerEX: the Beer EXpert system
;;;
;;;   This expert system suggests a beer to drink with a meal.
;;;
;;;   CLIPS 6.30
;;;
;;;   Author: Donato Meoli
;;;===========================================================

;;**************
;;* DEFGLOBALS *
;;**************

(defglobal
   ?*high-priority* = 1000
   ?*medium-high-priority* = 100
   ?*medium-low-priority* = -100
   ?*low-priority* = -1000)

;;****************
;;* DEFTEMPLATES *
;;****************

(deftemplate UI-state
   (slot id
      (default-dynamic (gensym*)))
   (slot display)
   (slot help)
   (slot why)
   (slot relation-asserted
      (default none))
   (multislot valid-answers)
   (slot response
      (default none))
   (slot state
      (default middle)))

(deftemplate state-list
   (slot current)
   (multislot sequence))

(deftemplate attribute
   (slot name)
   (slot value)
   (slot certainty
      (default 100.0)))

(deftemplate beer
   (slot style
      (type STRING)
      (allowed-strings "Pale Ale" "Dark Lager" "Brown Ale" "India Pale Ale" "Wheat Beer" "Strong Ale"
                       "Belgian Style" "Hybrid Beer" "Porter" "Stout" "Bock" "Scottish-Style Ale"
                       "Wild/Sour" "Pilsener & Pale Lager" "Specialty Beer"))
   (slot name
      (type STRING))
   (multislot alcohol
      (type SYMBOL)
      (allowed-symbols not-detectable mild noticeable harsh))
   (multislot color
      (type SYMBOL)
      (allowed-symbols pale amber brown dark))
   (multislot flavor
      (type SYMBOL)
      (allowed-symbols crisp-clean malty-sweet dark-roasty hoppy-bitter fruity-spicy sour-tart-funky))
   (multislot fermentation
      (type SYMBOL)
      (allowed-symbols top bottom wild))
   (multislot carbonation
      (type SYMBOL)
      (allowed-symbols low medium high))
   (slot link
      (type STRING)))

;;************
;;* DEFFACTS *
;;************

(deffacts startup
   (state-list))

(defrule load-beer-styles-list
  =>
  (load-facts clips/beer-styles.fct))

;;****************
;;* DEFFUNCTIONS *
;;****************

(deffunction sort-certainties (?a1 ?a2)
   (< (fact-slot-value ?a1 certainty) (fact-slot-value ?a2 certainty)))

;;*****************
;;* INITIAL STATE *
;;*****************

(defrule start
  =>
  (set-strategy random)
  (assert (UI-state (display (format nil "%n%s %n%n%s %n%n%s" "Welcome to the Beer EXpert system 🍻"
                                         (str-cat "⁉ All I need is that you answer simple questions by choosing "
                                                  "one of the responses that are offered to you.")
                                         "To start, please press the /new button 😄"))
                    (relation-asserted start)
                    (state initial))))

;;***********************
;;* BEER QUESTION RULES *
;;***********************

(defrule load-beer-question-rules
   =>
   (load clips/beer-questions.clp))

;;************************
;;* BEER KNOWLEDGE RULES *
;;************************

(defrule load-beer-knowledge-rules
   =>
   (load clips/beer-knowledge.clp))

;;********************************
;;* BEER SELECTION & PRINT RULES *
;;********************************

(defrule combine-certainties
   ?f1 <- (attribute (name ?name) (value ?value) (certainty ?certainty1))
   ?f2 <- (attribute (name ?name) (value ?value) (certainty ?certainty2))
   (test (neq ?f1 ?f2))
   =>
   (retract ?f1)
   (modify ?f2 (certainty (/ (- (* (+ ?certainty1 ?certainty2) 100) (* ?certainty1 ?certainty2)) 100))))

(defrule generate-beers
   (declare (salience ?*medium-low-priority*))
   (or (and (beer (style ?beer-style) (name ?beer-name) (link ?link))
            (attribute (name best-style) (value ?beer-style) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (link ?link))
            (attribute (name best-name) (value ?beer-name) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (alcohol $? ?alcohol $?) (link ?link))
            (attribute (name best-alcohol) (value ?alcohol) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (color $? ?color $?) (link ?link))
            (attribute (name best-color) (value ?color) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (flavor $? ?flavor $?) (link ?link))
            (attribute (name best-flavor) (value ?flavor) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (fermentation $? ?fermentation $?) (link ?link))
            (attribute (name best-fermentation) (value ?fermentation) (certainty ?certainty)))
       (and (beer (style ?beer-style) (name ?beer-name) (carbonation $? ?carbonation $?) (link ?link))
            (attribute (name best-carbonation) (value ?carbonation) (certainty ?certainty))))
   =>
   (assert (attribute (name beer)
                      (value (format nil "🍺 [%s - %s](%s)" ?beer-style ?beer-name ?link))
                      (certainty ?certainty))))

(defrule remove-poor-beer-choices
   ?f <- (attribute (name beer) (certainty ?certainty&:(< ?certainty 50)))
   =>
   (retract ?f))

(defrule print-results
   (declare (salience ?*low-priority*))
   (UI-state (id ?id))
   (state-list (current ?id))
   =>
   (do-for-all-facts ((?a attribute)) (neq ?a:name beer) (retract ?a))
   (bind ?beers "")
   (bind ?attributes (find-all-facts ((?a attribute)) (eq ?a:name beer)))
   (bind ?attributes (sort sort-certainties ?attributes))
   (progn$ (?a ?attributes)
           (bind ?beers (str-cat ?beers (format nil "%s with certainty %-2d%% %n"
                                                    (fact-slot-value ?a value) (fact-slot-value ?a certainty))))
           (retract ?a))
   (if (neq ?beers "")
    then (bind ?results (str-cat (format nil "%s %n%n" "*✅ Done. I have selected these beer styles for you.*") ?beers))
    else (bind ?results (format nil "%s %n%n%s" "*🚫 Sorry! I could not select any beer style for you. 😞"
                                                "Please, try again! 💪🏻*")))
   (assert (UI-state (display ?results)
                     (state final))))

;;*************************
;;* GUI INTERACTION RULES *
;;*************************

(defrule ask-question
   (declare (salience ?*medium-high-priority*))
   (UI-state (id ?id))
   ?f <- (state-list (sequence $?s&:(not (member$ ?id ?s))))
   =>
   (modify ?f (current ?id) (sequence ?id ?s))
   (halt))

(defrule handle-next-no-change-none-middle-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id)
   ?f2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   =>
   (retract ?f1)
   (modify ?f2 (current ?nid))
   (halt))

(defrule handle-next-response-none-end-of-chain
   (declare (salience ?*high-priority*))
   ?f <- (next ?id)
   (state-list (sequence ?id $?))
   (UI-state (id ?id) (relation-asserted ?relation))
   =>
   (retract ?f)
   (assert (add-response ?id)))

(defrule handle-next-no-change-middle-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id ?response)
   ?f2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
   (UI-state (id ?id) (response ?response))
   =>
   (retract ?f1)
   (modify ?f2 (current ?nid))
   (halt))

(defrule handle-next-change-middle-of-chain
   (declare (salience ?*high-priority*))
   (next ?id ?response)
   ?f1 <- (state-list (current ?id) (sequence ?nid $?b ?id $?e))
   (UI-state (id ?id) (response ~?response))
   ?f2 <- (UI-state (id ?nid))
   =>
   (modify ?f1 (sequence ?b ?id ?e))
   (retract ?f2))

(defrule handle-next-response-end-of-chain
   (declare (salience ?*high-priority*))
   ?f1 <- (next ?id ?response)
   (state-list (sequence ?id $?))
   ?f2 <- (UI-state (id ?id) (response ?expected) (relation-asserted ?relation))
   =>
   (retract ?f1)
   (if (neq ?response ?expected)
    then (modify ?f2 (response ?response)))
   (assert (add-response ?id ?response)))

(defrule handle-add-response
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?f <- (add-response ?id ?response)
   =>
   (if (eq (str-index " " ?response) FALSE)
    then (str-assert (str-cat "(" ?relation " " ?response ")"))
    else (str-assert (str-cat "(" ?relation " " "\"" ?response "\"" ")")))
   (retract ?f))

(defrule handle-add-response-none
   (declare (salience ?*high-priority*))
   (UI-state (id ?id) (relation-asserted ?relation))
   ?f <- (add-response ?id)
   =>
   (str-assert (str-cat "(" ?relation ")"))
   (retract ?f))

(defrule handle-prev
   (declare (salience ?*high-priority*))
   ?f1 <- (prev ?id)
   (UI-state (id ?id) (state ?state))
   ?f2 <- (state-list (sequence $?b ?id ?pid $?e))
   (UI-state (id ?pid) (relation-asserted ?relation))
   =>
   (retract ?f1)
   (modify ?f2 (current ?pid))
   (do-for-fact ((?r ?relation)) (neq ?relation start) (retract ?r))
   (if (eq ?state final)
    then (progn$ (?rule (get-defrule-list))
                 (if (neq (str-index "determine-best-beer-attributes" ?rule) FALSE)
                  then (refresh ?rule))))
   (halt))

update beerex.clp

update beerex.clp


(deffacts tovars
    (tovar TV 200 4 2015 Russia)
    (tovar Watch 199 5 2017 USA)
    (tovar Linkorn 1000 1 2010 Russia)
    (tovar IceCream 10 99 2017 Ukraine)
    (tovar Book 1 1 2001 Vanuatu)
)

(defrule ucenk
    (tovar ?name ?cost ?count ?year ?country)

    (test (or (?year < 2010)
              (?count < 4)
          )
    )
     =>
     (assert (ucenka ?name (* ?cost 0.15)))
)

Add task2 for chapter4

Add task2 for chapter4


(deffunction reflect (?s)
 (bind ?s1 "")
 (bind ?n (length ?s))
 (loop-for-count (?i 0 ?n) do
 (bind ?c (sub-string (- ?n ?i) (- ?n ?i) ?s))
 (bind ?s1 (str-cat ?s1 ?c)))
 ?s1)

Create task6.clp

Create task6.clp


;Get string, replace all spaces by "_"
(defrule replace
 =>
 (bind ?str (readline))
 (bind ?a " ")
 (bind ?b "_")
 (bind ?n (str-length ?str))
 (bind ?res "")
 (loop-for-count (?i 1 ?n) do
    (bind ?c1 (sub-string ?i ?i ?str))
    (bind ?d (str-compare ?c1 ?a))

    (if (= ?d 0) then
        (bind ?res (str-cat ?res ?b)))

    (if (<> ?d 0) then
        (bind ?res (str-cat ?res ?c1))))

 (printout t "result=" ?res crlf)
 )

Create task2.clp

Create task2.clp


// First task
// Students
(deffacts students
         (student LelyakinMA 4)
         (student ArutunyaAS 4)
         (student KefalicsAI 1)
         (student BelokobylskySA 2)
)

(facts)

(retract 2)
(retract 3)

(assert (student KefalicsAI 2))

(facts)

// Trains
(deffacts trains
          (train 11 Saratov 11)
          (train 22 Engels 21)
          (train 33 Kazan 22)
)

(assert (train 44 Samara 10))
(assert (train 55 Volgograd 08))

(retract 1 4)

(retract 2 3)

(assert (train 22 Moscow 01))
(assert (train 33 Kazan 00))

// Employees
(assert (sotrudnik LelyakinMA 1)
        (sotrudnik GerasimovVD 2)
        (sotrudnik VonnegutKG 3)
        (sotrudnik PushkinAS 3)
)

(retract 1)

(retract 3)
(assert (sotrudnik VasilevKD 3))

// Products
(assert (IceCream Russia 10 1)
		(ApelsineJuce Russia 20 2)
		(WaterMelone Russia 30 3)
		(Liberty USA 1000 99)
)

(facts)

(retract 2)
(ApelsineJuce Russia 19 2)

(retract 4)
(Liberty USA 0 99)

// First task
// Students
(deffacts students
         (student LelyakinMA 4)
         (student ArutunyaAS 4)
         (student KefalicsAI 1)
         (student BelokobylskySA 2)
)

(reset)
(facts)

(retract 2)
(retract 3)

(assert (student KefalicsAI 2))

(facts)

// Trains
(deffacts trains
          (train 11 Saratov 11)
          (train 22 Engels 21)
          (train 33 Kazan 22)
)

(reset)
(assert (train 44 Samara 10))
(assert (train 55 Volgograd 08))

(retract 1 4)

(retract 2 3)

(assert (train 22 Moscow 01))
(assert (train 33 Kazan 00))

// Employees
(assert (sotrudnik LelyakinMA 1)
        (sotrudnik GerasimovVD 2)
        (sotrudnik VonnegutKG 3)
        (sotrudnik PushkinAS 3)
)

(reset)
(retract 1)

(retract 3)
(assert (sotrudnik VasilevKD 3))

// Products
(assert (IceCream Russia 10 1)
		(ApelsineJuce Russia 20 2)
		(WaterMelone Russia 30 3)
		(Liberty USA 1000 99)
)

(reset)
(facts)

(retract 2)
(ApelsineJuce Russia 19 2)

(retract 4)
(Liberty USA 0 99)

Update chapter-2.clp

Update chapter-2.clp


(deffunction triangle (?a ?b ?c)
  (bind ?p (/ (+ ?a ?b ?c) 2))
  (sqrt (* ?p (- ?p ?a) (- ?p ?b) (- ?p ?c)))
)

;(deffunction compare-triangles (?a1 ?b1 ?c1 ?a2 ?b2 ?c2)
;  (> (triangle ?a1 ?b1 ?c1) (triangle ?a2 ?b2 ?c2))
;)

Create task2.clp

Create task2.clp


(deffacts tovars
    (tovar TV 200 4 2015 Russia)
    (tovar Watch 199 5 2017 USA)
    (tovar Linkorn 1000 1 2010 Russia)
    (tovar IceCream 10 99 2017 Ukraine)
    (tovar Book 1 1 2001 Vanuatu)
)

(defrule ucenk
    (tovar ?name ?cost ?count ?year ?country)

    (test (or (?year < 2010)
              (?count < 4)
          )
    )
     =>
     (assert (ucenka ?name (* ?cost 0.15)))
)

(deffacts tovars
    (tovar TV 200 4 2015 Russia)
    (tovar Watch 199 5 2017 USA)
    (tovar Linkorn 1000 1 2010 Armenia)
    (tovar IceCream 10 99 2017 Ukraine)
    (tovar Book 1 1 2001 Vanuatu)
)

(defrule ucenk
    (tovar ?name ?cost ?count ?year ?country)

    (test (or (< ?year 2010)
              (< ?count 4)
          )
    )
     =>
     (assert (ucenka ?name (* ?cost 0.15)))
)

(defrule nacenk
    (tovar ?name ?cost ?count ?year ?country)

    (test (and (= 0 (str-compare ?country Russia))
               (= ?year 2017)
          )
    )
     =>
    (assert (nacenka ?name (* ?cost 0.07)))
)

(defrule russian
    (tovar ?name ?cost ?count ?year ?country)

    (exists  (test (= 0 (str-compare ?country Russia))))
      =>
    (printout t "There are Russian production" crlf)
)

Update task2.clp

Update task2.clp


;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Pass.clp - Pass types that interact with LibIndirect
;------------------------------------------------------------------------------
(defclass indirect::PassBase
  "The base class of all passes (native or indirect)"
  (is-a Object)
  (slot pass-name (type SYMBOL STRING) (visibility public))
  (slot pass-description (type STRING) (visibility public)))
;------------------------------------------------------------------------------
(defclass indirect::NativePass
  "A wrapper over a native LLVM pass"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive))
;------------------------------------------------------------------------------
(defclass indirect::Pass
  "Represents an indirect pass that uses LibIndirect to interact with LLVM"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive)
  (slot pass-type (type SYMBOL) (allowed-symbols Unknown Module Function Region
																 Loop BasicBlock CallGraphSCC MachineFunction))
  (slot is-analysis (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot is-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-loops (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-regions (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-all (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (multislot passes (type SYMBOL))
  (multislot required (type SYMBOL))
  (multislot required-transitive (type SYMBOL))
  (multislot preserved (type SYMBOL))
  ;begin CLIPS specific slots
  (slot entry-point (type STRING))
  (message-handler register)
  (message-handler unregister)
  (message-handler is-registered))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass init around ()
						  (call-next-handler)
						  ;automatically load the code if there is an entry point
						  (if (and (< (str-length ?self:entry-point) 0)
									  (not (defmodule-exists ?self:pass-name))) then
							 (batch* ?self:entry-point))
						  (if (not (is-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass register ()
						  (if (not (is-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)
							 (return TRUE)
							 else
							 (printout werror "ERROR: pass already registered" crlf)
							 (return FALSE)))

;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass unregister ()
						  (unregister-pass ?self:pass-name))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass is-registered ()
						  (pass-registered ?self:pass-name))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Pass.clp - Pass types that interact with LibIndirect
;------------------------------------------------------------------------------
(defclass indirect::PassBase
  "The base class of all passes (native or indirect)"
  (is-a Object)
  (slot pass-name (type SYMBOL STRING) (visibility public))
  (slot pass-description (type STRING) (visibility public)))
;------------------------------------------------------------------------------
(defclass indirect::NativePass
  "A wrapper over a native LLVM pass"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive))
;------------------------------------------------------------------------------
(defclass indirect::Pass
  "Represents an indirect pass that uses LibIndirect to interact with LLVM"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive)
  (slot pass-type (type SYMBOL) (allowed-symbols Unknown Module Function Region
																 Loop BasicBlock CallGraphSCC MachineFunction))
  (slot is-analysis (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot is-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-loops (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-regions (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-all (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (multislot passes (type SYMBOL))
  (multislot required (type SYMBOL))
  (multislot required-transitive (type SYMBOL))
  (multislot preserved (type SYMBOL))
  ;begin CLIPS specific slots
  (slot entry-point (type STRING))
  (message-handler register)
  (message-handler unregister)
  (message-handler is-registered))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass init around ()
						  (call-next-handler)
						  ;automatically load the code if there is an entry point
						  (if (and (< (str-length ?self:entry-point) 0)
									  (not (defmodule-exists ?self:pass-name))) then
							 (batch* ?self:entry-point))
						  (if (not (pass-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass register ()
						  (if (not (is-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)
							 (return TRUE)
							 else
							 (printout werror "ERROR: pass already registered" crlf)
							 (return FALSE)))

;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass unregister ()
						  (unregister-pass ?self:pass-name))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass is-registered ()
						  (pass-registered ?self:pass-name))
;------------------------------------------------------------------------------

change the call to is-registered with pass-registered

This is because is-registered is the message name associated with the Pass
object while pass-regitered is the command that links into the C++ side of
things.


(defrule zachisl
  =>
    (printout t "Input the count of students")
    (bind ?n (read))
    (loop-for-count (?i 1 ?n) do
      (printout t "Input the last name:")
      (bind ?lastName (read))
      (assert (student ?lastName 1))
    )
)

Create task1.clp

Create task1.clp


(defrule replace
 =>
 (bind ?str (readline))
 (bind ?a (readline))
 (bind ?b (readline))
 (bind ?n (str-length ?str))
 (bind ?k 0)
 (loop-for-count (?i 1 ?n) do
    (bind ?c1 (sub-string ?i ?i ?str))
    (bind ?d (str-compare ?c1 ?a))

    (if (= ?d 0) then
        (printout t "k=" ?k crlf))))

Create task1.clp

Create task1.clp


!db2level ;   -- echo current db2 level
!db2set -r ;  -- reset all db2 registers

!db2set DB2_ROCM_DISABLE_FS_CHECK=TRUE;     -- set db2 register values
!db2set DB2_USE_FAST_SCATTERED_IO=OFF;
!db2set DB2_SYSTEM_RAM=1GB;

!db2set -all;     --echo all db2s regsiter values

!db2stop  ;
!db2start ;
create database ldrng_db ;
connect to ldrng_db ;

create long tablespace lng1 managed by database using (file 'tmp/lng1' 1000);
create tablespace reg1 managed by database using (file 'tmp/reg1' 10000);
create tablespace reg2 managed by database using (file 'tmp/reg2' 10000);
create tablespace inx1 managed by database using (file 'tmp/inx1' 30000);

create table TABLE130_9 ( a int , b double not null unique, c varchar(10) not null, d LONG VARCHAR) long in lng1 distribute by(b) organize by
dimensions(a,c) partition by range (a NULLS FIRST,b NULLS LAST) (part p0 starting (MINVALUE,MINVALUE) ending (9,MAXVALUE) in reg1, part p1 starting (10,0) ending (190000,MAXVALUE) in reg1, part p2 starting (200000,0) ending (500000,100000) in reg2);

create index indx1 on TABLE130_9 (a) not partitioned;
insert into TABLE130_9 values (1,2,'aa',NULL);

runstats on table TABLE130_9 with distribution and indexes all set profile only;

load from ldrng130_9.asc of ASC MODIFIED BY reclen= 1047 method L( 1 11, 13 34, 36 45, 47 1046) NULL INDICATORS ( 12, 35, 46, 1047) replace into TABLE130_9 statistics use profile;

select npages from sysstat.tables where tabname='TABLE130_9';

terminate;

Create repro_template.clp

Create repro_template.clp

repro template
usage:
blastdb
db2 -tvf repro_template.clp | tee repro.out


(defimport builtins list)
(defimport builtins print)
(defimport time sleep)

(doseq
  [x (pmap
    (fn [x]
      (do
        (sleep 0.5)
        (print "+ x 1:" x)
        (+ x 1)))
    (pmap
      (fn [x]
        (do
          (print "* x x:" x)
          (* x x)))
      [0 1 2 3 4 5 6 7 8 9]))]
  (print x))

Add an example

Add an example


(load clips/beerex.clp)

(deffunction ask-question (?display ?allowed-values)
   (bind ?answer "")
   (while (not (member ?answer ?allowed-values))
      (printout t " "?display " " ?allowed-values " ")
      (bind ?answer (readline))
      (if (eq (str-index " " ?answer) FALSE)
       then (bind ?answer (nth$ 1 (explode$ ?answer)))))
   ?answer)

(deffunction next-UI-state ()
   (do-for-fact ((?s state-list)) TRUE (and (bind ?current-id ?s:current)
                                            (bind ?sequence ?s:sequence)))
   (do-for-fact ((?u UI-state)) (eq ?u:id ?current-id) (and (bind ?display ?u:display)
                                                            (bind ?help ?u:help)
                                                            (bind ?why ?u:why)
                                                            (bind ?state ?u:state)
                                                            (bind ?valid-answers ?u:valid-answers)))
   (if (eq ?state initial)
    then (assert (next ?current-id))
         (run)
         (next-UI-state))
   (if (eq ?state middle)
    then (if (> (length$ ?sequence) 2)
          then (bind ?answer
                     (ask-question ?display (insert$ ?valid-answers (+ (length$ ?valid-answers) 1) help why prev cancel)))
          else (bind ?answer
                     (ask-question ?display (insert$ ?valid-answers (+ (length$ ?valid-answers) 1) help why cancel)))))
   (if (eq ?state final)
    then (bind ?answer (ask-question ?display (create$ prev restart cancel))))
   (if (member$ ?answer ?valid-answers)
    then (assert (next ?current-id ?answer))
         (run)
         (next-UI-state))
   (if (eq ?answer help)
    then (printout t ?help crlf)
         (next-UI-state))
   (if (eq ?answer why)
    then (printout t ?why crlf)
         (next-UI-state))
   (if (eq ?answer prev)
    then (assert (prev ?current-id))
         (run)
         (next-UI-state))
   (if (eq ?answer restart)
    then (reset)
         (run)
         (next-UI-state))
   (if (eq ?answer cancel)
    then (exit)))

(reset)
(run)

(next-UI-state)

(load clips/beerex.clp)

(deffunction ask-question (?display ?allowed-values)
   (bind ?answer "")
   (while (not (member ?answer ?allowed-values))
      (if (not (member$ prev ?allowed-values))
       then (printout t crlf))
      (printout t " " ?display " " ?allowed-values " ")
      (bind ?answer (readline))
      (if (eq (str-index " " ?answer) FALSE)
       then (bind ?answer (nth$ 1 (explode$ ?answer)))))
   ?answer)

(deffunction next-UI-state ()
   (do-for-fact ((?s state-list)) TRUE (and (bind ?current-id ?s:current)
                                            (bind ?sequence ?s:sequence)))
   (do-for-fact ((?u UI-state)) (eq ?u:id ?current-id) (and (bind ?display ?u:display)
                                                            (bind ?help ?u:help)
                                                            (bind ?why ?u:why)
                                                            (bind ?state ?u:state)
                                                            (bind ?valid-answers ?u:valid-answers)))
   (if (eq ?state initial)
    then (assert (next ?current-id))
         (run)
         (next-UI-state))
   (if (eq ?state middle)
    then (bind ?allowed-values ?valid-answers)
         (if (neq ?help nil)
          then (bind ?allowed-values (insert$ ?allowed-values (+ (length$ ?allowed-values) 1) help)))
         (if (neq ?why nil)
          then (bind ?allowed-values (insert$ ?allowed-values (+ (length$ ?allowed-values) 1) why)))
         (bind ?allowed-values (insert$ ?allowed-values (+ (length$ ?allowed-values) 1) cancel))
         (if (> (length$ ?sequence) 2)
          then (bind ?allowed-values (insert$ ?allowed-values (length$ ?allowed-values) prev)))
         (bind ?answer (ask-question ?display ?allowed-values)))
   (if (eq ?state final)
    then (bind ?answer (ask-question ?display (create$ prev restart cancel))))
   (if (member$ ?answer ?valid-answers)
    then (assert (next ?current-id ?answer))
         (run)
         (next-UI-state))
   (if (eq ?answer help)
    then (printout t ?help crlf)
         (next-UI-state))
   (if (eq ?answer why)
    then (printout t ?why crlf)
         (next-UI-state))
   (if (eq ?answer prev)
    then (assert (prev ?current-id))
         (run)
         (next-UI-state))
   (if (eq ?answer restart)
    then (reset)
         (run)
         (next-UI-state))
   (if (eq ?answer cancel)
    then (exit)))

(reset)
(run)

(next-UI-state)

update BeerEX.clp

update BeerEX.clp


; -*- clips -*-

;; **********************************************************************
;;                           Frame.clp
;;
;; A nifty example of building a a Swing GUI using jess reflection.
;; Using this package, we can create java objects, call their methods,
;; access their fields, and respond to GUI events.
;; You can therefore build an entire GUI application without actually
;; writing any Java code!
;;
;; **********************************************************************

;; ******************************
;; Declarations

(import javax.swing.*)
;; Explicit import so we get JFrame.EXIT_ON_CLOSE
(import javax.swing.JFrame)
(import java.awt.event.ActionListener)
(import java.awt.BorderLayout)
(import java.awt.Color)

;; ******************************
;; DEFGLOBALS

(defglobal ?*f* = 0)
(defglobal ?*c* = 0)
(defglobal ?*d* = 0)
(defglobal ?*e* = 0)

(defglobal ?*m* = 0)
(defglobal ?*envi* = 0)

;; ******************************
;; DEFFUNCTIONS

(deffunction create-frame ()
  (bind ?*f* (new JFrame "Jess Reflection Demo"))
  (bind ?*c* (?*f* getContentPane))
  (set ?*c* background (Color.magenta)))

(deffunction add-widgets ()
  (?*c* add (new JLabel "This is: ") (BorderLayout.CENTER))
  (bind ?*m* (new JComboBox))
  (bind ?*d* (new JComboBox))
  (bind ?*e* (new JComboBox))
  (?*m* addItem "paper")
  (?*m* addItem "tools")
  (?*m* addItem "buildings")
  (?*m* addItem "numbers")
  (?*c* add ?*m* (BorderLayout.SOUTH))
  (bind ?*envi* ?*m* selectedItem)
  (assert (environment ?*envi*))
  (?*e* addItem "paper")
  (?*e* addItem "tools")
  (?*e* addItem "buildings")
  (?*e* addItem "numbers")
  (?*c* add ?*e* (BorderLayout.NORTH))
  (bind ?*envi* ?*m* selectedItem)
  (assert (environment ?*envi*))
  (?*d* addItem "paper")
  (?*d* addItem "tools")
  (?*d* addItem "buildings")
  (?*d* addItem "numbers")
  (?*c* add ?*d* )
  (bind ?*envi* ?*d* selectedItem )
  (assert (environment ?*envi*)))

(deffunction add-behaviours ()
  (?*f* setDefaultCloseOperation (JFrame.EXIT_ON_CLOSE))

  (?*m* addActionListener (implement ActionListener using
    (lambda (?name ?event)
      (printout t "You chose: " (get ?*m* selectedItem) crlf)))))

(deffunction show-frame ()
  ;(?*f* pack)
    (?*f* setSize 200 300)
  (?*f* setVisible TRUE))

;; ******************************
;; Run the program

(defrule init-rule
    (initial-fact)
    =>
    (create-frame)
    (add-widgets)
    (add-behaviours)
    (show-frame))

(reset)
(run)

;;test now 2

add track

add track


(deffunction str-stars (?str ?n)
    (while (> ?n 0) do
        (bind ?str (str-cat ?str "*"))
        (bind ?n (- ?n 1))
    )
    ?str
)

(defrule str_start
=>
(bind ?str1 (read))
(bind ?str2 (read))
(if (> (str-length ?str1) (str-length ?str2)) then
    (bind ?diff (- (str-length ?str1) (str-length ?str2)))
    (printout t ?str1 crlf)
    (printout t (str-stars ?str2 ?diff) crlf)
else
    (bind ?diff (- (str-length ?str2) (str-length ?str1)))
    (printout t (str-stars ?str1 ?diff) crlf)
    (printout t ?str2 crlf)
))

Create task4.clp

Create task4.clp


(deffunction trim (?str)
    (bind ?str2 "")
    (bind ?space True)
    (bind ?n (str-length ?str))
    (bind ?i 0)
    (while (< ?i ?n) do
        (bind ?c1 (sub-string ?i ?i ?str))

        (if (= 0 (str-compare ?c1 " ")) then
            (if (and (?space True)) then
                (printout t "kefal")
                (bind ?space False)
                (bind ?str2 (str-cat ?str2 ?c1))
            )

        else

            (bind ?space True)
            (bind ?str2 (str-cat ?str2 ?c1))
        )
        (bind ?i (+ ?i 1))
    )
    ?str2
)

(deffunction trim (?str)
    (bind ?str2 "")
    (bind ?space TRUE)
    (bind ?n (str-length ?str))
    (bind ?i 0)
    (while (<= ?i ?n) do
        (bind ?c1 (sub-string ?i ?i ?str))

        (if (= 0 (str-compare ?c1 " ")) then
            (if (and ?space TRUE) then
                (bind ?space FALSE)
                (bind ?str2 (str-cat ?str2 ?c1))
            )

        else

            (bind ?space TRUE)
            (bind ?str2 (str-cat ?str2 ?c1))
        )
        (bind ?i (+ ?i 1))
    )
    ?str2
)

Update task5.clp

Update task5.clp


(defrule easy_summ
  =>
  (printout t "n=")
  (bind ?n (read))
  (bind ?s 0)
  (bind ?i 2)
  (while (<= ?i (* 2 ?n)) do
   (bind ?s (+ ?s (/ 1 (* ?i ?i))))
   (bind ?i (+ ?i 2))
  )
  (printout t "summ is:")
  (printout t ?s)
  (printout t "")
)

Create task4.clp

Create task4.clp


(load clips/beerex.clp)

(undefrule load-beer-knowledge-rules)
(undefrule load-beer-question-rules)

(load clips/beer-questions.clp)
(load clips/beer-knowledge.clp)

(deffunction ask-question (?display ?allowed-values)
   (bind ?answer "")
   (if (or (not (member$ prev ?allowed-values))
           (member$ restart ?allowed-values))
    then (printout t crlf))
   (while (not (member ?answer ?allowed-values))
      (printout t ?display " " ?allowed-values " ")
      (bind ?answer (readline))
      (if (member$ restart ?allowed-values)
       then (printout t crlf))
      (if (eq (str-index " " ?answer) FALSE)
       then (bind ?answer (nth$ 1 (explode$ ?answer)))))
   ?answer)

(deffunction next-UI-state ()
   (do-for-fact ((?s state-list)) TRUE (and (bind ?current-id ?s:current)
                                            (bind ?sequence ?s:sequence)))
   (do-for-fact ((?u UI-state)) (eq ?u:id ?current-id) (and (bind ?display ?u:display)
                                                            (bind ?help ?u:help)
                                                            (bind ?why ?u:why)
                                                            (bind ?state ?u:state)
                                                            (bind ?valid-answers ?u:valid-answers)))
   (if (eq ?state middle)
    then (bind ?allowed-values ?valid-answers)
         (if (neq ?help nil)
          then (bind ?allowed-values (insert$ ?allowed-values (+ (length$ ?allowed-values) 1) help)))
         (if (neq ?why nil)
          then (bind ?allowed-values (insert$ ?allowed-values (+ (length$ ?allowed-values) 1) why)))
         (bind ?allowed-values (insert$ ?allowed-values (+ (length$ ?allowed-values) 1) cancel))
         (if (> (length$ ?sequence) 2)
          then (bind ?allowed-values (insert$ ?allowed-values (length$ ?allowed-values) prev)))
         (bind ?answer (ask-question ?display ?allowed-values))
    else (if (eq ?state final)
          then (bind ?answer (ask-question ?display (create$ prev restart cancel)))
          else (assert (next ?current-id))
               (run)
               (next-UI-state)))
   (if (member$ ?answer ?valid-answers)
    then (assert (next ?current-id ?answer))
         (run)
         (next-UI-state)
    else (if (eq ?answer help)
          then (printout t crlf)
               (printout t ?help crlf)
               (printout t crlf)
               (next-UI-state))
         (if (eq ?answer why)
          then (printout t crlf)
               (printout t ?why crlf)
               (printout t crlf)
               (next-UI-state))
         (if (eq ?answer prev)
          then (assert (prev ?current-id))
               (run)
               (next-UI-state))
         (if (eq ?answer restart)
          then (reset)
               (run)
               (next-UI-state))
         (if (eq ?answer cancel)
          then (exit))))

(reset)
(run)

(next-UI-state)

(load clips/beerex.clp)

(undefrule load-beer-question-rules)
(load clips/beer-questions.clp)

(undefrule load-beer-knowledge-rules)
(load clips/beer-knowledge.clp)

(deffunction ask-question (?display ?allowed-values)
   (bind ?answer "")
   (if (or (not (member$ prev ?allowed-values))
           (member$ restart ?allowed-values))
    then (printout t crlf))
   (while (not (member$ ?answer ?allowed-values))
      (printout t ?display " ")
      (bind ?i 1)
      (progn$ (?value ?allowed-values)
              (printout t ?i "." ?value " ")
              (bind ?i (+ ?i 1)))
      (printout t "-> ")
      (if (neq (bind ?number (read-number)) "*** READ ERROR ***")
       then (bind ?answer (nth$ ?number ?allowed-values)))
      (if (member$ restart ?allowed-values)
       then (printout t crlf)))
   ?answer)

(deffunction next-UI-state ()
   (do-for-fact ((?s state-list)) TRUE (and (bind ?current-id ?s:current)
                                            (bind ?sequence ?s:sequence)))
   (do-for-fact ((?u UI-state)) (eq ?u:id ?current-id) (and (bind ?display ?u:display)
                                                            (bind ?help ?u:help)
                                                            (bind ?why ?u:why)
                                                            (bind ?state ?u:state)
                                                            (bind ?valid-answers ?u:valid-answers)))
   (if (eq ?state middle)
    then (bind ?allowed-values ?valid-answers)
         (if (neq ?help nil)
          then (bind ?allowed-values (insert$ ?allowed-values (+ (length$ ?allowed-values) 1) help)))
         (if (neq ?why nil)
          then (bind ?allowed-values (insert$ ?allowed-values (+ (length$ ?allowed-values) 1) why)))
         (bind ?allowed-values (insert$ ?allowed-values (+ (length$ ?allowed-values) 1) cancel))
         (if (> (length$ ?sequence) 2)
          then (bind ?allowed-values (insert$ ?allowed-values (length$ ?allowed-values) prev)))
         (bind ?answer (ask-question ?display ?allowed-values))
    else (if (eq ?state final)
          then (bind ?answer (ask-question ?display (create$ prev restart cancel)))
          else (assert (next ?current-id))
               (run)
               (next-UI-state)))
   (if (member$ ?answer ?valid-answers)
    then (assert (next ?current-id ?answer))
         (run)
         (next-UI-state)
    else (if (eq ?answer help)
          then (printout t crlf)
               (printout t ?help crlf)
               (printout t crlf)
               (next-UI-state))
         (if (eq ?answer why)
          then (printout t crlf)
               (printout t ?why crlf)
               (printout t crlf)
               (next-UI-state))
         (if (eq ?answer prev)
          then (assert (prev ?current-id))
               (run)
               (next-UI-state))
         (if (eq ?answer restart)
          then (reset)
               (run)
               (next-UI-state))
         (if (eq ?answer cancel)
          then (exit))))

(reset)
(run)

(next-UI-state)

update BeerEX.clp

update BeerEX.clp


(defrule node
  =>
  (printout t "n1=")
  (bind ?n1 (read))
  (printout t "n2=")
  (bind ?n2 (read))
  (while TRUE do
    (if (= ?n1 ?n2) then
      (printout t "nod is: " ?n1)
      (return)
    )

    (if (> ?n1 ?n2) then
      (bind ?n1 (- ?n1 ?n2))
    else
      (bind ?n2 (- ?n2 ?n1))
    )
  )
)

Create task6.clp

Create task6.clp


(defrule replace
 =>
 (bind ?str (readline))
 (bind ?a (readline))
 (bind ?b (readline))
 (bind ?n (str-length ?str))
 (bind ?k 0)
 (loop-for-count (?i 1 ?n) do
    (bind ?c1 (sub-string ?i ?i ?str))
    (bind ?d (str-compare ?c1 ?a))

    (if (= ?d 0) then
        (printout t "k=" ?k crlf))))

;Get string, first symbol and second symbol.
;Replace all entityes of first symbol with second.
(defrule replace
 =>
 (bind ?str (readline))
 (bind ?a (readline))
 (bind ?b (readline))
 (bind ?n (str-length ?str))
 (bind ?res "")
 (loop-for-count (?i 1 ?n) do
    (bind ?c1 (sub-string ?i ?i ?str))
    (bind ?d (str-compare ?c1 ?a))

    (if (= ?d 0) then
        (bind ?res (str-cat ?res ?b)))

    (if (<> ?d 0) then
        (bind ?res (str-cat ?res ?c1))))

 (printout t "result=" ?res crlf)
 )

Update task1.clp

Update task1.clp


;;; The Manners Benchmark implemented using CLIPS
;;; The original source for the OPS5 benchmark suite is available
;;; at http://www.cs.utexas.edu/ftp/pub/ops5-benchmark-suite/

;;; Changes made for the CLIPS version
;;;
;;;   Reformatted code
;;;   Changed the logical name to which the program output
;;;     is sent to a global variable so that the program
;;;     output can be easily enabled/disabled.

;;; ##########
;;; Defglobals
;;; ##########

(bind ?*output*  t) ; Disabled = nil Enabled = t

;;; ############
;;; Deftemplates
;;; ############

(deftemplate guest
   (slot name)
   (slot sex)
   (slot hobby))

(deftemplate last_seat
   (slot seat))

(deftemplate seating
   (slot seat1)
   (slot seat2)
   (slot name1)
   (slot name2)
   (slot id)
   (slot pid)
   (slot path_done))

(deftemplate context
   (slot state))

(deftemplate path
   (slot id)
   (slot name)
   (slot seat))

(deftemplate chosen
   (slot id)
   (slot name)
   (slot hobby))

(deftemplate count
   (slot c))

;;; ########
;;; Defrules
;;; ########

;;; *****************
;;; assign_first_seat
;;; *****************

(defrule assign_first_seat
   ?f1 <- (context (state start))
   (guest (name ?n))
   ?f3 <- (count (c ?c))
   =>
   (assert (seating (seat1 1) (name1 ?n) (name2 ?n) (seat2 1) (id ?c) (pid 0) (path_done yes)))
   (assert (path (id ?c) (name ?n) (seat 1)))
   (modify ?f3 (c (+ ?c 1)))
   (printout ?*output* "first seat 1 " ?n " " ?n " 1 " ?c " 0 1" crlf)
   (modify ?f1 (state assign_seats)))

;;; ************
;;; find_seating
;;; ************

(defrule find_seating
   ?f1 <- (context (state assign_seats))
   (seating (seat1 ?seat1) (seat2 ?seat2) (name2 ?n2) (id ?id) (pid ?pid) (path_done yes))
   (guest (name ?n2) (sex ?s1) (hobby ?h1))
   (guest (name ?g2) (sex ~?s1) (hobby ?h1))
   ?f5 <- (count (c ?c))
   (not (path (id ?id) (name ?g2)))
   (not (chosen (id ?id) (name ?g2) (hobby ?h1)))
   =>
   (assert (seating (seat1 ?seat2) (name1 ?n2) (name2 ?g2) (seat2 (+ ?seat2 1)) (id ?c) (pid ?id) (path_done no)))
   (assert (path (id ?c) (name ?g2) (seat (+ ?seat2 1))))
   (assert (chosen (id ?id) (name ?g2) (hobby ?h1)))
   (modify ?f5 (c (+ ?c 1)))
   (printout ?*output* "seat1: " ?seat2 " seat2: " (+ ?seat2 1) " Name1: " ?n2 " Name2: " ?g2 crlf)
   (modify ?f1 (state make_path)))

;;; *********
;;; make_path
;;; *********

(defrule make_path
   (context (state make_path))
   (seating (id ?id) (pid ?pid) (path_done no))
   (path (id ?pid) (name ?n1) (seat ?s))
   (not (path (id ?id) (name ?n1)))
   =>
   (assert (path (id ?id) (name ?n1) (seat ?s))))

;;; *********
;;; path_done
;;; *********

(defrule path_done
   ?f1 <- (context (state make_path))
   ?f2 <- (seating (path_done no))
   =>
   (modify ?f2 (path_done yes))
   (modify ?f1 (state check_done)))

;;; ***********
;;; are_we_done
;;; ***********

(defrule are_we_done
   ?f1 <- (context (state check_done))
   (last_seat (seat ?l_seat))
   (seating (seat2 ?l_seat))
   =>
   (printout ?*output* crlf "Yes, we are done!!" crlf)
   (modify ?f1 (state print_results)))

;;; ********
;;; continue
;;; ********

(defrule continue
   ?f1 <- (context (state check_done))
   =>
   (modify ?f1 (state assign_seats))
)

;;; *************
;;; print_results
;;; *************

(defrule print_results
   (context (state print_results))
   (seating (id ?id) (seat2 ?s2))
   (last_seat (seat ?s2))
   ?f4 <- (path (id ?id) (name ?n) (seat ?s))
   =>
   (retract ?f4)
   (printout ?*output* "Seat: " ?s " Name: " ?n  crlf))

;;; ********
;;; all_done
;;; ********

(defrule all_done
   (context (state print_results))
   =>
(printout t "ALL DONE")
)

(assert
(guest (name n1) (sex m) (hobby h3))
(guest (name n1) (sex m) (hobby h2))

(guest (name n1) (sex m) (hobby h4))
(guest (name n1) (sex m) (hobby h5))
(guest (name n1) (sex m) (hobby h6))

(guest (name n2) (sex m) (hobby h2))
(guest (name n2) (sex m) (hobby h3))

;(guest (name n3) (sex m) (hobby h1))
;(guest (name n3) (sex m) (hobby h2))
;(guest (name n3) (sex m) (hobby h3))

(guest (name n4) (sex f) (hobby h3))
(guest (name n4) (sex f) (hobby h2))

(guest (name n4) (sex f) (hobby h5))
(guest (name n4) (sex f) (hobby h6))

(guest (name n5) (sex f) (hobby h1))
(guest (name n5) (sex f) (hobby h2))
(guest (name n5) (sex f) (hobby h3))

;(guest (name n6) (sex f) (hobby h3))
;(guest (name n6) (sex f) (hobby h1))
;(guest (name n6) (sex f) (hobby h2))

;(guest (name n7) (sex f) (hobby h3))
;(guest (name n7) (sex f) (hobby h2))

;(guest (name n8) (sex m) (hobby h3))
;(guest (name n8) (sex m) (hobby h1))

(last_seat (seat 4))
(count (c 1))
(context (state start)))

test manners

test manners

git-svn-id: 9643e93313b82f5e4da82d8413267a0daa4b5472@1495 2cd91b7d-3b21-0410-a5f4-f42db4f24360


(defrule spisok-sotr
  =>
    (printout t "Input the count of employees")
    (bind ?n (read))
    (loop-for-count (?i 1 ?n) do
      (printout t "Input the last name:")
      (bind ?lastName (read))
      (printout t "Input the doljnost:")
      (bind ?doljn (read))
      (assert (sotr ?lastName ?doljn))
    )
)

Create task2.clp

Create task2.clp


% = MPPD DOMAIN: CLINGCON ENCODING =================================================================

% Move actions
#include "./action-MPP.clp".

% Order fulfillment (Goal condition)
#include "./goal-D-r.clp

% Highway constraints
#include "../control/highways.clp".

% Output conversion
#include "./output-MPPD.lp".

% = MPPD DOMAIN: CLINGCON ENCODING =================================================================

% Move actions
#include "./action-MPP.clp".

% Order fulfillment (Goal condition)
#include "./goal-D-r.clp".

% Highway constraints
#include "../control/highways.clp".

% Output conversion
#include "./output-MPPD.lp".

Fix typo in encoding-r.clp

Fix typo in encoding-r.clp