CLIPS - How can I exclude characters from IF/READ statement's exceptions? - if-statement

The code is asking a y/n question to the user and making a change - simple. The statement seems to accept only integer and float types and I need only two answers, so I used 1 and 0, and excluded the rest, BUT it reads only numbers, so only the numbers are excluded, not characters.
(defrule rule01
=>
(printout t "Question (yes=1/no=0)?" crlf)
(bind ?x (read))
(if (!= ?x 1)
then
(if (= ?x 0)
then
(assert (rule01 no))
else (printout t "Use ONLY 0 OR 1 for your answers!" crlf))
else (assert (rule01 yes))))
Currently, when you try to type in a character, it returns the following:
CLIPS> (run)
Question (yes=1/no=0)?
g
[ARGACCES5] Function <> expected argument #1 to be of type integer or float
[PRCCODE4] Execution halted during the actions of defrule rule01.
How can I put in an exception for characters?

Use eq and neq in place of = and <>.
CLIPS (6.31 6/12/19)
CLIPS>
(defrule rule01
=>
(printout t "Question (yes=1/no=0)?" crlf)
(bind ?x (read))
(if (neq ?x 1)
then
(if (eq ?x 0)
then
(assert (rule01 no))
else (printout t "Use ONLY 0 OR 1 for your answers!" crlf))
else (assert (rule01 yes))))
CLIPS> (reset)
CLIPS> (run)
Question (yes=1/no=0)?
g
Use ONLY 0 OR 1 for your answers!
CLIPS>

Related

Clojure set string value

I have a variable "testtext".
Depending on a other variable "testvalue", thats always the value 1 or 2, it needs to be set to something.
So if testvalue is 1, i need to set testtext to "its one".
And when testvalue is 2, i need to set testtext to "its two".
Right now i have:
(cond
(= testvalue 1) (var-set testtext "its one")
(= testvalue 2) (var-set testtext "its two")
:else (var-set testtext "ERROR")
)
But i get the error "String cannot be cast to clojure.lang.Var"
So my question is, how do i properly set a string value, assuming that's what I did wrong.
You want something more like this:
(let [result (cond
(= testvalue 1) "its one"
(= testvalue 2) "its two"
:else "ERROR" ) ]
(println "result:" result))
Using var-set is very rare in Clojure. I can't answer in too much more detail without knowing your exact use-case.
If you really need something like a Java variable, you could use a Clojure atom:
(def result (atom nil))
(cond
(= testvalue 1) (reset! result "its one")
(= testvalue 2) (reset! result "its two")
:else (reset! result "ERROR" ))
(println "result:" #result))
You probably want something like:
(defn func
[test-value]
(let [test-var (cond
(= test-value 1) "it's one"
(= test-value 2) "it's two"
:else "ERROR")]
test-var))
=> #'user/func
(func 1)
=> "it's one"
(func 2)
=> "it's two"
(func 3)
=> "ERROR"
The let form let's you assign values to vars. Sticking it in a function is a convenient way to return the result.
On most contexts you don't want to modify an existing "variable's" value, instead you use let to bind a value to a symbol. It would be easier to answer if we knew the bigger picture, but as already mentioned atom is a datatype to which you can atomically swap in a new value.
I'd say this is more idiomatic, although not quite what you asked:
(def lookup-table
{1 "its one"
2 "its two"})
(defn make-lookup [i]
(get lookup-table i "ERROR"))
(doseq [i (range 4)]
(println i "=" (make-lookup i)))
Prints:
0 = ERROR
1 = its one
2 = its two
3 = ERROR
Instead of thinking how to assign a value to a variable, you should think what do you want to use that value for.

Plumatic Schema for keyword arguments

Say we have a function get-ints with one positional argument, the number of ints the caller wants, and two named arguments :max and :min like:
; Ignore that the implementation of the function is incorrect.
(defn get-ints [nr & {:keys [max min] :or {max 10 min 0}}]
(take nr (repeatedly #(int (+ (* (rand) (- max min -1)) min)))))
(get-ints 5) ; => (8 4 10 5 5)
(get-ints 5 :max 100) ; => (78 43 32 66 6)
(get-ints 5 :min 5) ; => (10 5 9 9 9)
(get-ints 5 :min 5 :max 6) ; => (5 5 6 6 5)
How does one write a Plumatic Schema for the argument list of get-ints, a list of one, three or five items where the first one is always a number and the following items are always pairs of a keyword and an associated value.
With Clojure Spec I'd express this as:
(require '[clojure.spec :as spec])
(spec/cat :nr pos-int? :args (spec/keys* :opt-un [::min ::max]))
Along with the separate definitions of valid values held by ::min and ::max.
I think this is a case when it is easier to write the specific code you need rather than trying to force-fit a solution using Plumatic Schema or some other tool that is not designed for this use-case. Keep in mind that Plumatic Schema & other tools (like the built-in Clojure pre- & post-conditions) are just a shorthand way of throwing an Exception when some condition is violated. If none of these DSL's are suitable, you always have the general-purpose language to fall back on.
A similar situation to yours can be found in the Tupelo library for the rel= function. It is designed to perform a test for "relative equality" between two numbers. It works like so:
(is (rel= 123450000 123456789 :digits 4 )) ; .12345 * 10^9
(is (not (rel= 123450000 123456789 :digits 6 )))
(is (rel= 0.123450000 0.123456789 :digits 4 )) ; .12345 * 1
(is (not (rel= 0.123450000 0.123456789 :digits 6 )))
(is (rel= 1 1.001 :tol 0.01 )) ; :tol value is absolute error
(is (not (rel= 1 1.001 :tol 0.0001 )))
While nearly all other functions in the Tupelo library make heavy use of Plumatic Schema, this one does it "manually":
(defn rel=
"Returns true if 2 double-precision numbers are relatively equal, else false. Relative equality
is specified as either (1) the N most significant digits are equal, or (2) the absolute
difference is less than a tolerance value. Input values are coerced to double before comparison.
Example:
(rel= 123450000 123456789 :digits 4 ) ; true
(rel= 1 1.001 :tol 0.01) ; true
"
[val1 val2 & {:as opts}]
{:pre [(number? val1) (number? val2)]
:post [(contains? #{true false} %)]}
(let [{:keys [digits tol]} opts]
(when-not (or digits tol)
(throw (IllegalArgumentException.
(str "Must specify either :digits or :tol" \newline
"opts: " opts))))
(when tol
(when-not (number? tol)
(throw (IllegalArgumentException.
(str ":tol must be a number" \newline
"opts: " opts))))
(when-not (pos? tol)
(throw (IllegalArgumentException.
(str ":tol must be positive" \newline
"opts: " opts)))))
(when digits
(when-not (integer? digits)
(throw (IllegalArgumentException.
(str ":digits must be an integer" \newline
"opts: " opts))))
(when-not (pos? digits)
(throw (IllegalArgumentException.
(str ":digits must positive" \newline
"opts: " opts)))))
; At this point, there were no invalid args and at least one of
; either :tol and/or :digits was specified. So, return the answer.
(let [val1 (double val1)
val2 (double val2)
delta-abs (Math/abs (- val1 val2))
or-result (truthy?
(or (zero? delta-abs)
(and tol
(let [tol-result (< delta-abs tol)]
tol-result))
(and digits
(let [abs1 (Math/abs val1)
abs2 (Math/abs val2)
max-abs (Math/max abs1 abs2)
delta-rel-abs (/ delta-abs max-abs)
rel-tol (Math/pow 10 (- digits))
dig-result (< delta-rel-abs rel-tol)]
dig-result))))
]
or-result)))
Based on the answer I got from the Plumatic mailing list [0] [1] I sat down and wrote my own conformer outside of the schema language itself:
(defn key-val-seq?
([kv-seq]
(and (even? (count kv-seq))
(every? keyword? (take-nth 2 kv-seq))))
([kv-seq validation-map]
(and (key-val-seq? kv-seq)
(every? nil? (for [[k v] (partition 2 kv-seq)]
(if-let [schema (get validation-map k)]
(schema/check schema v)
:schema/invalid))))))
(def get-int-args
(schema/constrained
[schema/Any]
#(and (integer? (first %))
(key-val-seq? (rest %) {:max schema/Int :min schema/Int}))))
(schema/validate get-int-args '()) ; Exception: Value does not match schema...
(schema/validate get-int-args '(5)) ; => (5)
(schema/validate get-int-args [5 :max 10]) ; => [5 :max 10]
(schema/validate get-int-args [5 :max 10 :min 1]); => [5 :max 10 :min 1]
(schema/validate get-int-args [5 :max 10 :b 1]) ; Exception: Value does not match schema...

How to have multiple if statements inside a function in Clojure?

I want to do this in Clojure:
int i=1;j=2;k=3;
str r;
cin>>r;
if(r=="A")
cout<<i; (i.e., print 1)
if(r=="J")
cout<<j; (i.e., print 2)
if(r=="K")
cout<<k; (i.e., print 3)
else
do something else
I am doing it like this in clojure:
(defn str-to-num [c]
(if ( = (str (first c )) "A")
1
(java.lang.Integer/valueOf (str (first c))))
(if ( = (str (first c )) "J")
2
(java.lang.Integer/valueOf (str (first c))))
(if ( = (str (first c )) "K")
3
(java.lang.Integer/valueOf (str (first c))))
)
But, I'm getting an error. Could someone tell what I'm doing wrong?
All of the if blocks are run, one after the other, regardless of what any of them return. If you want if / else / chaining you should use cond or case (though the two branches of a standard if work fine if there are only two options).
Your first two if blocks can't do anything meaningful except throw an error. And that is exactly what will happen for most inputs.
"A", "J", and "K" are not valid numbers, so trying to parse them will throw an error.
The only meaningful things this function can do is return the first letter of a string as a number if it is parsible as one.
user> (str-to-num "A")
NumberFormatException For input string: "A" java.lang.NumberFormatException.forInputString (NumberFormatException.java:65)
user> (str-to-num "J")
NumberFormatException For input string: "J" java.lang.NumberFormatException.forInputString (NumberFormatException.java:65)
user> (str-to-num "K")
NumberFormatException For input string: "K" java.lang.NumberFormatException.forInputString (NumberFormatException.java:65)
user> (str-to-num "100")
1
perhaps you wanted something like:
user> (defn str-to-num [c]
(case (first c)
\A 1
\J 2
\K 3
(int (first c))))
#'user/str-to-num
user> (str-to-num "A")
1
user> (str-to-num "J")
2
user> (str-to-num "K")
3
user> (str-to-num "L")
76
user> (str-to-num "☃")
9731
Alternately:
user> (defn str-to-num [c]
(case (first c)
\A 1
\J 2
\K 3
(Integer/parseInt (subs c 0 1))))
#'user/str-to-num
user> (str-to-num "9")
9
The problem is with the form of your if statement
You have
(if ( = (str (first c )) "A")
1
(java.lang.Integer/valueOf (str (first c))))
The form of if is
(if (cond)
trueResult
falseResult)
So your "working version" will return 1 if you input A. If you input any other string, it actually throws an error. But, if an error were not thrown, all three if statements would be executed, and the result of the last one is actually returned.
This is closer to your C++ code:
(defn str-to-num [c]
(if ( = (str (first c )) "A") (print 1))
(if ( = (str (first c )) "J") (print 2))
(if ( = (str (first c )) "K") (print 3)))

Regexp Emacs for R comments

I would like to build a regexp in Emacs for cleaning up my R code.
One of the problems I ran into was that there are different types of comments:
You have those with a certain amount of whitespace (1), e.g.:
# This is a comment:
# This is also a comment
or you have situations like this (2):
require(lattice) # executable while the comment is informative
The idea is that I want to align the comments when they are of the second kind (after something that's executable), while excluding those of the first kind.
Ideally, it will align all the comments BETWEEN those of the first kind, but not those of the first kind.
Example:
funfun <- function(a, b) {
# This is a function
if (a == b) { # if a equals b
c <- 1 # c is 1
}
}
#
To:
funfun <- function(a, b) {
# This is a function
if (a == b) { # if a equals b
c <- 1 # c is 1
}
}
#
I found a regexp to do a replacement for those of the first kind, so then I was able to align them per paragraph (mark-paragraph). That worked kind of well.
Problem is then the backsubstitution:
(replace-regexp "^\\s-+#+" "bla" nil (point-min) (point-max))
This replaces from the start of a line, with any amount of whitespace and any amount of comment characters like:
#########
into
bla
The problem is that I would like to replace them back into what they are originally, so "bla" has to go back into the same amount of whitespace and same amount of #.
Hopefully someone understands what I am trying to do and has either a better idea for an approach or knows how to solve this regexp part.
Well, here's some crazy attempt at doing something I thought you were after. It seems to work, but it needs a lot of testing and polishing:
(defun has-face-at-point (face &optional position)
(unless position (setq position (point)))
(unless (consp face) (setq face (list face)))
(let ((props (text-properties-at position)))
(loop for (key value) on props by #'cddr
do (when (and (eql key 'face) (member value face))
(return t)))))
(defun face-start (face)
(save-excursion
(while (and (has-face-at-point face) (not (bolp)))
(backward-char))
(- (point) (save-excursion (move-beginning-of-line 1)) (if (bolp) 0 -1))))
(defun beautify-side-comments ()
(interactive)
;; Because this function does a lot of insertion, it would
;; be better to execute it in the temporary buffer, while
;; copying the original text of the file into it, such as
;; to prevent junk in the formatted buffer's history
(let ((pos (cons (save-excursion
(beginning-of-line)
(count-lines (point-min) (point)))
(- (save-excursion (end-of-line) (point)) (point))))
(content (buffer-string))
(comments '(font-lock-comment-face font-lock-comment-delimiter-face)))
(with-temp-buffer
(insert content)
(goto-char (point-min))
;; thingatpt breaks if there are overlays with their own faces
(let* ((commentp (has-face-at-point comments))
(margin
(if commentp (face-start comments) 0))
assumed-margin pre-comment commented-lines)
(while (not (eobp))
(move-end-of-line 1)
(cond
((and (has-face-at-point comments)
commentp) ; this is a comment continued from
; the previous line
(setq assumed-margin (face-start comments)
pre-comment
(buffer-substring-no-properties
(save-excursion (move-beginning-of-line 1))
(save-excursion (beginning-of-line)
(forward-char assumed-margin) (point))))
(if (every
(lambda (c) (or (char-equal c ?\ ) (char-equal c ?\t)))
pre-comment)
;; This is the comment preceded by whitespace
(setq commentp nil margin 0 commented-lines 0)
(if (<= assumed-margin margin)
;; The comment found starts on the left of
;; the margin of the comments found so far
(save-excursion
(beginning-of-line)
(forward-char assumed-margin)
(insert (make-string (- margin assumed-margin) ?\ ))
(incf commented-lines))
;; This could be optimized by going forward and
;; collecting as many comments there are, but
;; it is simpler to return and re-indent comments
;; (assuming there won't be many such cases anyway.
(setq margin assumed-margin)
(move-end-of-line (1- (- commented-lines))))))
((has-face-at-point comments)
;; This is the fresh comment
;; This entire block needs refactoring, it is
;; a repetition of the half the previous blockp
(setq assumed-margin (face-start comments)
pre-comment
(buffer-substring-no-properties
(save-excursion (move-beginning-of-line 1))
(save-excursion (beginning-of-line)
(forward-char assumed-margin) (point))))
(unless (every
(lambda (c)
(or (char-equal c ?\ ) (char-equal c ?\t)))
pre-comment)
(setq commentp t margin assumed-margin commented-lines 0)))
(commentp
;; This is the line directly after a block of comments
(setq commentp nil margin assumed-margin commented-lines 0)))
(unless (eobp) (forward-char)))
;; Retrieve back the formatted contnent
(setq content (buffer-string))))
(erase-buffer)
(insert content)
(beginning-of-buffer)
(forward-line (car pos))
(end-of-line)
(backward-char (cdr pos))))
I've also duplicated it on pastebin for better readability: http://pastebin.com/C2L9PRDM
EDIT: This should restore the mouse position but will not restore the scroll position (could be worked to, perhaps, I'd just need to look for how scrolling is stored).
align-regexp is the awesome bit of emacs magic you need:
(defun align-comments ()
"align R comments depending on whether at start or in the middle."
(interactive)
(align-regexp (point-min) (point-max)
"^\\(\\s-*?\\)\\([^[:space:]]+\\)\\(\\s-+\\)#" 3 1 nil) ;type 2 regex
(align-regexp (point-min) (point-max)
"^\\(\\s-*\\)\\(\\s-*\\)#" 2 0 nil)) ;type 1 regex
before:
# a comment type 1
## another comment type 1
a=1 ###### and a comment type 2 with lots of #####'s
a.much.longer.variable.name=2 # and another, slightly longer type 2 comment
## and a final type 1
after:
# a comment type 1
## another comment type 1
a=1 ###### and a comment type 2 with lots of #####'s
a.much.longer.variable.name=2 # and another, slightly longer type 2 comment
## and a final type 1
Try
(replace-regexp "^\\(\\s-+\\)#" "\\1bla" nil (point-min) (point-max))
then
(replace-regexp "^\\(\\s-+\\)bla+" "\\1#" nil (point-min) (point-max))
but If I understood you well, I would probably do something like :
(align-string "\b\s-#" begin end)

CLIPS increment certainty to some items in a list

I have a wine defined like this:
(deftemplate wine
(slot name)
(slot color)
(slot certainty (type NUMBER) (default 0)))
And the list dof wines defined like this:
(deffacts wines
(wine (name "Chardonnay") (color white))
(wine (name "Merlot") (color red))
(wine (name "Cabernet sauvignon") (color red)))
Now, in case a rule gets triggered, I'd like to increase certainty value for items in a list which have a color slot set to "red".
Any ideas how to accomplish this?
I'm new to CLIPS so I'm sure there is a better way but the following rules do what you want:
(defrule inc-wines-with-color
(increase-all-with color ?color ?amount)
(wine (name ?name) (color ?color))
=>
(assert (increase-certainty ?name ?amount)))
(defrule retract-inc-all-with
?f <- (increase-all-with $?)
=>
(retract ?f))
(defrule increase-wine-certainty
(not (increase-all-with $?))
?ic <-(increase-certainty ?name ?amount)
?wine <- (wine (name ?name) (certainty ?c))
=>
(printout t "Incrementing " ?name " from " ?c " to " (+ ?amount ?c) crlf)
(modify ?wine (certainty (+ ?amount ?c)))
(retract ?ic))
Here are the results of running it:
CLIPS> (reset)
CLIPS> (assert (increase-all-with color red 0.2))
<Fact-4>
CLIPS> (run)
Incrementing Merlot from 0 to 0.2
Incrementing Cabernet sauvignon from 0 to 0.2
CLIPS> (facts)
f-0 (initial-fact)
f-1 (wine (name "Chardonnay") (color white) (certainty 0))
f-7 (wine (name "Merlot") (color red) (certainty 0.2))
f-8 (wine (name "Cabernet sauvignon") (color red) (certainty 0.2))
For a total of 4 facts.
Note: You may need to set your conflict resolution strategy to LEX or MEA to guarantee proper ordering of the rules.