CLIPS asserting facts with OR condition in RHS - conditional-statements

is there a way in CLIPS to handle rules like:
(defrule temperature
(IT-IS-COLD-INSIDE TRUE)
=>
(assert
(IT-IS-COLD-OUTSIDE TRUE)
)
(or
(assert (WINDOW-IS-OPEN TRUE))
(assert (DOOR-IS-OPEN TRUE))
)
)
What I am curious about is that, for example, another rule fires and let's say the result of that rule is that the DOOR-IS-OPEN gets asserted to FALSE, then can CLIPS conclude that this means that the WINDOW-IS-OPEN must be TRUE (if of course IT-IS-COLD-INSIDE is TRUE already)?
or I should just write it in the other way around like:
(defrule temperature
(or
(WINDOW-IS-OPEN TRUE)
(DOOR-IS-OPEN TRUE)
)
(IT-IS-COLD-OUTSIDE TRUE)
=>
(assert (IT-IS-COLD-INSIDE TRUE))
)
The problem with this one is that it is not always true in my use case (the first example always covers the truth though). Let's say maybe there is very strong heating inside. I could just add this also to the picture, but it is not always possible. I am trying to develop a system that can work on data that are partially defined.
When I run my original example, it asserts the first fact (WINDOW-IS-OPEN TRUE) but never the second.
The syntax is probably wrong, but I guess you have the idea of what I am trying to achieve.

First define two deftemplates: one for representing known attribute values and another for representing deducible attribute values. Groupings of deducible attribute values will be grouped together using the link slot.
CLIPS (6.31 6/12/19)
CLIPS>
(deftemplate av
(slot attribute)
(slot value))
CLIPS>
(deftemplate dav
(slot attribute)
(slot value)
(slot link))
CLIPS>
(deffacts initial
(av (attribute it-is-cold-inside)
(value TRUE)))
CLIPS>
Your temperature rule can then be implemented with the following code.
CLIPS>
(defrule temperature
(av (attribute it-is-cold-inside)
(value TRUE))
=>
(assert (av (attribute it-is-cold-outside)
(value TRUE))
(dav (attribute window-is-open)
(value TRUE)
(link temperature))
(dav (attribute door-is-open)
(value TRUE)
(link temperature))))
CLIPS>
Next create rules for managing the deducible attribute values. The remove-dav rule will remove any dav fact when there is a known av fact that conflicts with it. The one-remaining-dav rule will convert a dav fact into an av fact when it is the last remaining dav fact for a specific link.
CLIPS>
(defrule remove-dav
(declare (salience 10))
?dav <- (dav (attribute ?a)
(value ?v))
(av (attribute ?a)
(value ~?v))
=>
(retract ?dav))
CLIPS>
(defrule one-remaining-dav
?dav <- (dav (attribute ?a)
(value ?v)
(link ?l))
(not (and (dav (attribute ?a2)
(value ?v2)
(link ?l))
(test (or (neq ?a ?a2)
(neq ?v ?v2)))))
=>
(retract ?dav)
(assert (av (attribute ?a)
(value ?v))))
CLIPS>
So when the temperature rule initially creates the deductible attribute values:
CLIPS> (reset)
CLIPS> (watch rules)
CLIPS> (watch facts)
CLIPS> (run)
FIRE 1 temperature: f-1
==> f-2 (av (attribute it-is-cold-outside) (value TRUE))
==> f-3 (dav (attribute window-is-open) (value TRUE) (link temperature))
==> f-4 (dav (attribute door-is-open) (value TRUE) (link temperature))
CLIPS>
The appropriate deductions can be made when new information is later added:
CLIPS> (assert (av (attribute door-is-open) (value FALSE)))
==> f-5 (av (attribute door-is-open) (value FALSE))
<Fact-5>
CLIPS> (run)
FIRE 1 remove-dav: f-4,f-5
<== f-4 (dav (attribute door-is-open) (value TRUE) (link temperature))
FIRE 2 one-remaining-dav: f-3,*
<== f-3 (dav (attribute window-is-open) (value TRUE) (link temperature))
==> f-6 (av (attribute window-is-open) (value TRUE))
CLIPS>

Thanks Gary! I think this is what I was looking for.
I modified the code a little bit to be a little bit more understandable:
(defrule temperature
(av (attribute it-is-cold-inside)
(value TRUE))
=>
(assert (av (attribute it-is-cold-outside)
(value TRUE))
(dav (attribute window-is-open)
(value MAYBE)
(link temperature))
(dav (attribute door-is-open)
(value MAYBE)
(link temperature))))
(defrule one-remaining-dav
?dav <- (dav (attribute ?a)
(value ?v)
(link ?l))
(not (and (dav (attribute ?a2)
(value ?v2)
(link ?l))
(test (or (neq ?a ?a2)
(neq ?v ?v2)))))
=>
(retract ?dav)
(assert (av (attribute ?a)
(value TRUE))))

Related

How to join values from hash-maps?

i fetched some SQL tables via JDBC and I need to do another transformation before i create a new table and insert values.
I got these two hash-maps:
Chapters:
(
{:chapter_uuid "b7984dde-50a1-4147-bfee-95bbd068e031", :l1_chapter_text
120876M, :l2_chapter_text nil, :l3_chapter_text nil, :l4_chapter_text nil}
{:chapter_uuid "23df4f27-534b-4cdb-81ed-dbdc8b9b140c", :l1_chapter_text
120880M, :l2_chapter_text 120876M, :l3_chapter_text nil, :l4_chapter_text
121621M}
)
Translation:
(
{:translation_id 3258779M, :translation_text 120876M, :translation_language "cs",
:translation_name "Vnější fasáda"}
{:translation_id 3258780M, :translation_text 120876M, :translation_language "en",
:translation_name "Exterior Signage"}
{:translation_id 3258782M, :translation_text 120880M, :translation_language "cs",
:translation_name "Čistá výloha"}
{:translation_id 3258783M, :translation_text 121621M, :translation_language "cs",
:translation_name "Vnější signalizace"}
{:translation_id 3258784M, :translation_text 121621M, :translation_language "en",
:translation_name "Pre-signalization"}
)
This is what i need to get:
Where Chapters.lx_chapter_text = Translation.translation_text -> swap Chapters.lx_chapter_text with translation_name and insert :language value -> Make sure that every language has its own hash-map!
(
{:chapter_uuid "b7984dde-50a1-4147-bfee-95bbd068e031", :l1_chapter_text
"Vnější fasáda", :l2_chapter_text nil, :l3_chapter_text nil, :l4_chapter_text nil
:language "cs"}
{:chapter_uuid "b7984dde-50a1-4147-bfee-95bbd068e031", :l1_chapter_text
"Exterior Signage", :l2_chapter_text nil, :l3_chapter_text nil, :l4_chapter_text nil
:language "en"}
{:chapter_uuid "23df4f27-534b-4cdb-81ed-dbdc8b9b140c", :l1_chapter_text
"Čistá výloha", :l2_chapter_text "Vnější fasáda", :l3_chapter_text nil, :l4_chapter_text
"Vnější signalizace" :language "cs"}
{:chapter_uuid "23df4f27-534b-4cdb-81ed-dbdc8b9b140c", :l1_chapter_text
120880M, :l2_chapter_text "Exterior Signage", :l3_chapter_text nil, :l4_chapter_text
"Pre-signalization" :language "en"}
)
This is how far i´ve got:
but as you can see this is not right (bad nested)
Can you tell me how to do it right? Thank you!
(defn test_table []
(for [language (distinct(map #(:translation_language %) translation))]
(for [chapter chapters]
(for [text translation]
(cond
(and (= (:l1_chapter_text chapter) (:translation_text text)) (= (:translation_language text) language))
(assoc chapter :l1_chapter_text (:translation_name text) :language (:translation_language text))
(and (= (:l2_chapter_text chapter) (:translation_text text)) (= (:translation_language text) language))
(assoc chapter :l2_chapter_text (:translation_name text) :language (:translation_language text))
(and (= (:l3_chapter_text chapter) (:translation_text text)) (= (:translation_language text) language))
(assoc chapter :l3_chapter_text (:translation_name text) :language (:translation_language text))
(and (= (:l4_chapter_text chapter) (:translation_text text)) (= (:translation_language text) language))
(assoc chapter :l4_chapter_text (:translation_name text) :language (:translation_language text))))))
(test-table)
->
((({:chapter_uuid "b7984dde-50a1-4147-bfee-95bbd068e031", :l1_chapter_text "Vnější fasáda",
:l2_chapter_text nil, :l3_chapter_text nil, :l4_chapter_text nil, :language "cs"}
nil nil nil nil)
({:chapter_uuid "23df4f27-534b-4cdb-81ed-dbdc8b9b140c", :l1_chapter_text 120880M,
:l2_chapter_text "Vnější fasáda", :l3_chapter_text nil, :l4_chapter_text 121621M, :language "cs"}
nil
{:chapter_uuid "23df4f27-534b-4cdb-81ed-dbdc8b9b140c", :l1_chapter_text "Čistá výloha",
:l2_chapter_text 120876M, :l3_chapter_text nil, :l4_chapter_text 121621M, :language "cs"}
{:chapter_uuid "23df4f27-534b-4cdb-81ed-dbdc8b9b140c", :l1_chapter_text 120880M,
:l2_chapter_text 120876M, :l3_chapter_text nil, :l4_chapter_text "Vnější signalizace", :language "cs"}
nil))
((nil
{:chapter_uuid "b7984dde-50a1-4147-bfee-95bbd068e031", :l1_chapter_text "Exterior Signage",
:l2_chapter_text nil, :l3_chapter_text nil, :l4_chapter_text nil, :language "en"}
nil nil nil)
(nil
{:chapter_uuid "23df4f27-534b-4cdb-81ed-dbdc8b9b140c", :l1_chapter_text 120880M,
:l2_chapter_text "Exterior Signage", :l3_chapter_text nil, :l4_chapter_text 121621M, :language "en"}
nil nil
{:chapter_uuid "23df4f27-534b-4cdb-81ed-dbdc8b9b140c", :l1_chapter_text 120880M,
:l2_chapter_text 120876M, :l3_chapter_text nil, :l4_chapter_text "Pre-signalization", :language "en"})))
First, do you have a list of all languages that are used in translations? If not, let's derive it from the translations collection:
(def langs (distinct (map :translation_language translations))) ;; => ("cs" "en")
Second, as you are going to use the translations collection as a lookup table, it makes sense to make a map of it. The easiest (though maybe not the most efficient) way to do it is to use the group-by function:
(def translations-map
(group-by (juxt :translation_text :translation_language) translations))
Looks like what you need to do is to convert each :l<#>_chapter_text to the actual text, or keep the id if the translation is not available in the given language. Using the map we have created, it is almost trivial:
(defn translate [id lang]
(or (:translation_name (first (get translations-map [id lang])))
id))
Now, let's put it all together, taking each chapter and, for each language, trying to replace all ids with translations:
(for [chapter chapters
lang langs]
(-> chapter
(assoc :language lang)
(update :l1_chapter_text translate lang)
(update :l2_chapter_text translate lang)
(update :l3_chapter_text translate lang)
(update :l4_chapter_text translate lang)))
This should return the desired result.
(let [a ...
b ...]
(as-> [:l1_chapter_text :l2_chapter_text :l3_chapter_text :l4_chapter_text]
relations
(interleave relations (repeat :translation_text))
(apply hash-map relations)
(mapcat #(clojure.set/join a b (into {} [%])) relations)
(group-by (fn [a] (apply str ((juxt :chapter_uuid :l1_chapter_text :l2_chapter_text :l3_chapter_text :l4_chapter_text :translation_language) a))) relations)
(vals relations)))

Test pre-requisites for tabular tests; how does tabular work?

Let's say I am attempting to test an api that is supposed to handle presence or absence of certain object fields.
Let's say I have tests like so:
(def without-foo
{:bar "17"})
(def base-request
{:foo "12"
:bar "17"})
(def without-bar
{:foo "12"})
(def response
{:foo "12"
:bar "17"
:name "Bob"})
(def response-without-bar
{:foo "12"
:bar ""
:name "Bob"})
(def response-without-foo
{:bar "17"
:foo ""
:name "Bob"})
(facts "blah"
(against-background [(external-api-call anything) => {:name => "Bob"})
(fact "base"
(method-under-test base-request) => response)
(fact "without-foo"
(method-under-test without-foo) => response-without-foo)
(fact "without-bar"
(method-under-test without-bar) => response-without-bar))
This works as you would expect and the tests pass. Now I am attempting to refactor this using tabular like so:
(def request
{:foo "12"
:bar "17"})
(def response
{:foo "12"
:bar "17"
:name "Bob"})
(tabular
(against-background [(external-api-call anything) => {:name "Bob"})]
(fact
(method-under-test (merge request ?diff) => (merge response ?rdiff))
?diff ?rdiff ?description
{:foo nil} {:foo ""} "without foo"
{} {} "base case"
{:bar nil} {bar ""} "without bar")
Which results in:
FAIL at (test.clj:123)
Midje could not understand something you wrote:
It looks like the table has no headings, or perhaps you
tried to use a non-literal string for the doc-string?
Ultimately I ended up with:
(tabular
(fact
(method-under-test (merge request ?diff) => (merge response ?rdiff) (provided(external-api-call anything) => {:name "Bob"}))
?diff ?rdiff ?description
{:foo nil} {:foo ""} "without foo"
{} {} "base case"
{:bar nil} {bar ""} "without bar")
Which passes. My question is. How does the tabular function differ from the facts function, and why does one of them accept an against-background while the other blows up?
You need to have following nesting if you want to establish background prerequisites for all your tabular based facts:
(against-background [...]
(tabular
(fact ...)
?... ?...))
For example:
(require '[midje.repl :refer :all])
(defn fn-a []
(throw (RuntimeException. "Not implemented")))
(defn fn-b [k]
(-> (fn-a) (get k)))
(against-background
[(fn-a) => {:a 1 :b 2 :c 3}]
(tabular
(fact
(fn-b ?k) => ?v)
?k ?v
:a 1
:b 3
:c 3))
(check-facts)
;; => All checks (3) succeeded.
If you want to have a background prerequisite per each tabular case you need to nest it as following:
(tabular
(against-background [...]
(fact ...))
?... ?...)
It's important to have the table just under tabular level, not nested in against-background or fact.
For example:
(require '[midje.repl :refer :all])
(defn fn-a []
(throw (RuntimeException. "Not implemented")))
(defn fn-b [k]
(-> (fn-a) (get k)))
(tabular
(against-background
[(fn-a) => {?k ?v}]
(fact
(fn-b ?k) => ?v))
?k ?v
:a 1
:b 2
:c 3)
(check-facts)
;; => All checks (3) succeeded.
In your code it looks like the tabular data is not positioned correctly (parentheses, brackets and curly braces are not balanced correctly so it's impossible to say what exactly is incorrect).

mocking a function call in midje

Say I have a function
(defn extenal_api_fn [stuff]
... do things....
)
(defn register_user [stuff]
(external_api_fn stuff))
And then a test
(def stuff1
{:user_id 123 })
(def stuff2
{:user_id 234})
(background (external_api_fn stuff1) => true
(with-redefs [external_api_fn (fn [data] (println "mocked function"))]
(register_user stuff1) => true)
(register_user stuff2) => true)
(facts "stuff goes here"
(fact "user that registers correctly
(= 1 1) => truthy)
(fact "user that has a registration failure"
(= 1 2) => falsy))
This fails with
"you never said #'external_api_fn" would be called with these arguments:
contents of stuff1
What would be a good way to stub this function call (in only some cases) in order to simulate an internal transaction failure.
You could use Midje's provided:
(fact
(register_user stuff1) => :registered
(provided
(extenal_api_fn stuff1) => :registered))
(fact
(register_user stuff2) => :error
(provided
(external_api_fn stuff2) => :error))
You can also stub a function to return a value no matter input parameters by using anything in place of the function argument:
(fact
(register_user stuff2) => :error
(provided
(external_api_fn anything) => :error))

Checking the input to match fact in Clips

I have a problem with trying to get an input and fact-check it with symptoms in the asserted facts.
(deftemplate disease
(slot name)
(multislot symptom ))
(assert (disease
(name nitro-def) (symptom stunted-growth pale-yellow reddish-brown-leaf)))
(assert (disease
(name phosphor-def) (symptom stunted-root-growth spindly-stalk purplish-colour)))
(assert (disease
(name potassium-def) (symptom purple-colour weakened-stems shriveled-seeds)))
(defrule reading-input
(disease (name ?name1) (symptom ?symptom1))
=>
(printout t "Enter the symptom your plant exhibits: " )
(assert (var (read))))
(defrule checking-input
?vars <- (var)
(disease (name ?name1) (symptom ?symptom1))
(disease (symptom ?vars&:(eq ?vars ?symptom1)))
=>
(printout t "Disease is " ?name1 crlf))
So basically you input a symptom and Clips returns the disease that matches that symptom. Problem is, that after Loading the file as Batch and running it, nothing happens. The Facts are asserted but no input is required. Nothing even touches the first rule.
If anyone can help me in this issue, I would be dully grateful!
Thanks!
You've defined symptom as a multifield slot (a slot containing zero or more fields), but your patterns matching those slots will only match if the slot contains a single field. Use a multifield variable such as $?symptom1 instead of a single field variable such as ?symptom1 to retrieve multiple values.
CLIPS>
(deftemplate disease
(slot name)
(multislot symptom))
CLIPS>
(deffacts diseases
(disease (name nitro-def)
(symptom stunted-growth pale-yellow reddish-brown-leaf))
(disease (name phosphor-def)
(symptom stunted-root-growth spindly-stalk purplish-colour))
(disease (name potassium-def)
(symptom purple-colour weakened-stems shriveled-seeds)))
CLIPS>
(defrule reading-input
=>
(printout t "Enter the symptom your plant exhibits: " )
(assert (var (read))))
CLIPS>
(defrule checking-input
(var ?symptom)
(disease (name ?name1) (symptom $?symptom1))
(test (member$ ?symptom ?symptom1))
=>
(printout t "Disease is " ?name1 crlf))
CLIPS> (reset)
CLIPS> (run)
Enter the symptom your plant exhibits: stunted-growth
Disease is nitro-def
CLIPS> (reset)
CLIPS> (run)
Enter the symptom your plant exhibits: purplish-colour
Disease is phosphor-def
CLIPS> (reset)
CLIPS> (run)
Enter the symptom your plant exhibits: spindly-stalk
Disease is phosphor-def
CLIPS>

Fetching with JoinQueryOver: Get greatgrandchildren, know father

Object Structure:
A house has many rooms.
A room has many tables.
A table has many vases (on it).
House > Rooms > Tables > Vases.
I'd like to use JoinQueryOver to select all tables with vases that are red - in a particular house.
I thought to do this:
var v = session.QueryOver<House>()
.Where(x => x.ID == HouseID)
.JoinQueryOver<Room>(x => x.Rooms)
.JoinQueryOver<Table>(x => x.Tables)
.JoinQueryOver<Vase>(x => x.Vases)
.Where(x => x.Color == "Red")
.SingleOrDefault<House>();
This was an approach I tried (of the many that failed). I don't really want the House and Room info.
Ultimately, I'm looking for a List of Tables (in a particular house), with their collections of Vases (that are red) fetched.
Thanks for the help!
Edit
Something like this would be nice:
var v = session.QueryOver<Table>()
.Where(x => x.Room.House.ID == HouseID) // this Where won't work.
.JoinQueryOver<Vase>(x => x.Vases)
.Where(x => x.Color == "Red")
.List().ToList();
var v = session.QueryOver<Table>()
.JoinAlias(x => x.Room, () => room)
.Where(() => room.House.ID == HouseID)
.JoinQueryOver<Vase>(x => x.Vases)
.Where(x => x.Color == "Red")
.List();