Suppose following portion of code in C:
void function(int n,int x)
{
int i,j;
int max=5;
int p[max]; // for example: p[max]={{100,1,100,3,10}};
...
...
for(i=0; i<n; i++)
if(i!=x)
{
j=i;
do
{
j=p[j];
}
while(j!=x);
}
...
}
I try following in CLIPS, but the condition in while loop is evaluated before [do] execution, which is not the case in the portion of C language code above where [do] is executed befor while loop:
(deftemplate q
(slot line (type INTEGER)(default 1))
(slot column (type INTEGER))
(slot value (type INTEGER))
)
(deffacts Data ; for example
(q (line 1)(column 1)(value 100))
(q (line 1)(column 2)(value 1))
(q (line 1)(column 3)(value 100))
(q (line 1)(column 4)(value 3))
(q (line 1)(column 5)(value 10))
)
(deffunction function (?n ?x)
(loop-for-count (?i 1 ?n)
(if (!= ?i ?x)
then
(bind ?j ?i)
(while (!= ?j ?x) do
(do-for-all-facts ((?q q))
(and
(= (fact-slot-value ?q line) 1)
(= (fact-slot-value ?q column) ?j)
)
(bind ?j (fact-slot-value ?q value))
)
)
)
)
)
Question: Is it a correct code ? Any help will be welcome. Thanks in advance.
Do ... while is not directly supported, but you can put a break statement at the end of the while body to implement that functionality:
(deffunction function (?n ?x)
(loop-for-count (?i 1 ?n)
(if (!= ?i ?x)
then
(bind ?j ?i)
(while TRUE do
(do-for-all-facts ((?q q))
(and
(= (fact-slot-value ?q line) 1)
(= (fact-slot-value ?q column) ?j)
)
(bind ?j (fact-slot-value ?q value))
)
(if (!= ?j ?x) then (break))
)
)
)
)
Ok general dumb overpowered solution: define a macro kind of like this (pseudocode I never quite got the hang of lisp syntax)
(defmacro do-while (#test #body) (
(body)
(while (!= ?j ?x) do (body))
))
I think you can even skip the middle man and embed the loop directly into the recursive expansion but I simply don't know enough to force it to tail-recurse.
Related
I wanted to define a new clause for the iterate macro. Something similar to Python's range where you have a start, stop, step. Here's a first try:
(defmacro-clause (for var start start stop stop step step)
(if (minusp step)
`(for ,var from ,start downto ,stop by (- ,step))
`(for ,var from ,start to ,stop by ,step)))
It deals with increasing and decreasing ranges using the to and downto keywords of iterate. (Note that, unlike Python, these include the stop value.)
This works as desired for
(iter (for x start 5 stop 3 step -1)
(collect x))
;; => (5 4 3)
(iter (for x start 2 stop 5 step 1)
(collect x))
;; => (3,4,5)
However it fails for anything like
(let ((a 9)
(b 3)
(c -1))
(iter (for x start a stop b step c)
(collect x)))
Is it a quirk of iterate that it requires explicit numbers in these places? It has no problem with things like
(iter (for x below (+ 3 3) by (+ 1 1))
(collect x))
Concretely my question is, how can I define a new iterate clause that accepts variables which are bound to numbers in these places?
The problem is that you are trying to decide things at macro-expansion time which can't be known then, such as the sign of a variable. In particular you can't write a macro which expands into (part of) another macro depending on anything which is only known at run time, or you can, but that necessarily means you have to call the moral equivalent of eval at run-time, and ... don't do that.
Instead you have to make the decision about which way to count at run-time. This means you can't use any of the (for var from ...) or related clauses because there don't seem to be any which are agnostic about direction (why (for i from 1 to -5 by -1) doesn't work is beyond me but ... well).
So whatever clause you end up with needs to expand into a (for var next ...) clause, I think.
Here is an attempt at such. Disclaimer: not tested very much, I don't use iterate, may explode on contact, poisonous to fish.
(defmacro-driver (for v in-range a to b &optional by s)
(let ((firstp (make-symbol "FIRSTP"))
(value (make-symbol "VALUE"))
(limit (make-symbol "LIMIT"))
(step (make-symbol "STEP")))
`(progn
(with ,firstp = t)
(with ,value = (let ((v ,a))
(unless (numberp v)
(warn "doomed"))
(when (null v)
(warn "extremely doomed"))
v))
(with ,limit = (let ((v ,b))
(unless (numberp v)
(warn "also doomed"))
v))
(with ,step = (let ((v (or ,s (signum (- ,limit ,value)))))
(when (not (numberp v))
(warn "doomed again"))
(when (zerop v)
(warn "zero step"))
(when (not (= (signum v) (signum (- ,limit ,value))))
(warn "likely doomed"))
v))
(,(if generate 'generate 'for)
,v
next (if ,firstp
(progn
(setf ,firstp nil)
,value)
(progn
(incf ,value ,step)
(when (if (> ,step 0)
(>= ,value ,limit)
(<= ,value ,limit))
(terminate))
,value))))))
And now
> (iter (for i in-range 1 to 5 by 2)
(print i))
1
3
nil
> (iter (for i in-range 1 to -1)
(print i))
1
0
nil
> (iter (for i in-range 1 to 5 by -2)
(when (< i -20)
(terminate)))
Warning: likely doomed
nil
Obviously some of the checks could be better.
I'm learning (common) Lisp, and as exercise, I want to implement 'xond', a cond macro, that transform this silly example:
(xond (= n 1) (setq x 2) (= n 2) (setq x 1))
into a if-else chain:
(if (= n 1) (setq x 2) (if (= n 2) (setq x 1)))
Currently, I have this macro:
(defmacro xond (&rest x) (if x (list 'progn (list 'if (pop x) (pop x)))))
that just expand the first two items in x:
(macroexpand '(xond (= x 1) (setq y 2)))
produce
(PROGN (IF (= X 1) (SETQ Y 2))) ;
Now I want to process all items in x, so I add a loop to produce a if-serie (a step toward if-else-version):
(defmacro xond (&rest x)
(loop (if x
(list 'progn (list 'if (pop x) (pop x)))
(return t))))
but then macro seems to stop working:
(macroexpand '(xond (= x 1) (setq y 2)))
T ;
What I'm missing here?
Edition
verdammelt's answer put me in the right track, and coredump's made me change my approach to an iterative one.
Now I'll implement (xond test1 exp1 test2 exp2) as:
(block nil
test1 (return exp1)
test2 (return exp2)
)
which can be done by iteration.
I'm writing this for my minimal Lisp interpreter; I have only implemented the most basic functions.
This is what I wrote. I'm using la to accumulate the parts of the output.
(defmacro xond (&rest x)
(let ((la '()))
(loop
(if x (push (list 'if (pop x) (list 'return (pop x))) la)
(progn (push 'nil la)
(push 'block la)
(return la)
)))))
with
(macroexpand '(xond (= x 1) (setq y 2) (= X 2) (setq y 1)))
result:
(BLOCK NIL
(IF (= X 2) (RETURN (SETQ Y 1)))
(IF (= X 1) (RETURN (SETQ Y 2)))
) ;
Second edition
Add a label to block and change return to return-from, to avoid conflict with other return inside arguments. Also changed push for append to generate code in the same orden as the parameters.
(defmacro xond (&rest x)
(let ((label (gensym)) (la '()) (condition nil) (expresion nil))
(setq la (append la (list 'block label)))
(loop
(if x
(setq la (append la (list
(list 'if (pop x) (list 'return-from label (pop x))))))
(return la)))))
So
(macroexpand '(xond (= x 1) (setq y 2) (= X 2) (setq y 1)))
now gives
(BLOCK #:G3187 (IF (= X 1) (RETURN-FROM #:G3187 (SETQ Y 2))) (IF (= X 2) (RETURN-FROM #:G3187 (SETQ Y 1))))
Some remarks
You do not need a progn when you only expand into a single if
The use of pop might be confusing for the reader (and the programmer too) since it mutates a place, maybe you want to start with a less imperative approach
Also, in that case I don't think a loop approach is helpful, because you need to nest the expressions that come after in the body inside a previously built form, and even though it can be done, it is a bit more complex to do that simply a recursive function or a "recursive" macro.
Here I explain both approach, starting with "recursive" macro (the quote here is because the macro does not call itself, but expands as call to itself).
Macro expansion fixpoint
If I had to implement xond, I would write a macro that expands into other calls to xond, until macroexpansion reaches a base case where there are no more xond:
(defmacro xond (&rest body)
(if (rest body)
(destructuring-bind (test if-action . rest) body
`(if ,test ,if-action (xond ,#rest)))
(first body)))
For example, this expression:
(xond (= n 1) (setq x 2) (= n 2) (setq x 1))
First macroexpands into:
(if (= n 1)
(setq x 2)
(xond (= n 2) (setq x 1)))
And eventually reaches a fixpoint with:
(if (= n 1)
(setq x 2)
(if (= n 2)
(setq x 1)
nil))
Be careful, you cannot directly use xond inside the definition of xond, what happens is that the macro expands as a call to xond, which Lisp then expands again. If you are not careful, you may end up with an infinite macroexpansion, that's why you need a base case where the macro does not expand into xond.
Macro calling a recursive function
Alternatively, you can call a recursive function inside your macro, and expand all the inner forms at once.
With LABELS, you bind xond-expand to a recursive function. Here this is an actual recursive approach:
(labels ((xond-expand (body)
(if body
(list 'if
(pop body)
(pop body)
(xond-expand body))
nil)))
(xond-expand '((= n 1) (setq x 2) (= n 2) (setq x 1))))
; => (IF (= N 1)
; (SETQ X 2)
; (IF (= N 2)
; (SETQ X 1)
; NIL))
Your xond macro ends with (return t) so it evaluates to t rather than your accumulated if expressions.
You could use loop's collect clause to accumulate the code you wish to return. For example: (loop for x in '(1 2 3) collect (* 2 x)) would evaluate to (2 4 6).
How about
(ql:quickload :alexandria)
(defun as-last (l1 l2)
`(,#l1 ,l2))
(defmacro xond (&rest args)
(reduce #'as-last
(loop for (condition . branch) in (alexandria:plist-alist args)
collect `(if ,condition ,branch))
:from-end t))
(macroexpand-1 '(xond c1 b1 c2 b2 c3 b3))
;; (IF C1 B1 (IF C2 B2 (IF C3 B3))) ;
;; T
alexandria's plist-alist was used to pair the arguments,
the intrinsic destructuring in loop used to extract conditions and branches.
The helper function as-last stacks lists together in the kind of
(a b c) (d e f) => (a b c (d e f)).
(reduce ... :from-end t) right-folds the sequence of the collected (if condition branch) clauses stacking them into each other using #'as-last.
Without any dependencies
('though, does alexandria even count as a dependency? ;) )
(defun pairs (l &key (acc '()) (fill-with-nil-p nil))
(cond ((null l) (nreverse acc))
((null (cdr l)) (pairs (cdr l)
:acc (cons (if fill-with-nil-p
(list (car l) nil)
l)
acc)
:fill-with-nil-p fill-with-nil-p))
(t (pairs (cdr (cdr l))
:acc (cons (list (car l) (cadr l)) acc)
:fill-with-nil-p fill-with-nil-p))))
(defun as-last (l1 l2)
`(,#l1 ,l2))
(defmacro xond (&rest args)
(reduce #'as-last
(loop for (condition branch) in (pairs args)
collect `(if ,condition ,branch))
:from-end t))
(macroexpand-1 '(xond c1 b1 c2 b2 c3 b3))
;; (IF C1 B1 (IF C2 B2 (IF C3 B3))) ;
;; T
The helper function pairs makes out of (a b c d e f) => ((a b) (c d) (e f)).
(:fill-with-nil-p determines in case of odd number of list elements, whether the last element would be listed (last-el) or (last-el nil) - in the latter case filled with nil).
I am pretty new in expert programming and stuck with a problem.
I want to find out if a fact exists and then do some operation based on those facts in RHS.
For Eg:- I have 4 facts.
(deffacts test (A 1) (B 2) (C 3) (D 4))
in following Rule fact E does not exist. so it Never goes to RHS. and dose not fire the rule.
(defrule rul1
(declare (salience 10))
(A ?var1)
(B ?var2)
(C ?var3)
(E ?var4)
=>
(if
(
or (or (or (= ?var1 1) (= ?var2 1)) (= ?var3 1)) (= ?var4 4)
)
then
(printout t "Rule matched" crlf))
)
)
My requirement is if a fact doesn't exist simply ignore that or assign a dummy value so that it can fire Rule.
How can I achieve this?
Try placing the matching logic in the conditions of the rule rather than the actions:
CLIPS>
(deffacts test (A 1) (B 2) (C 3) (D 4))
CLIPS>
(defrule rul1
(declare (salience 10))
(or (A 1)
(B 1)
(C 1)
(E 4))
=>
(printout t "Rule matched" crlf))
CLIPS> (reset)
CLIPS> (agenda)
10 rul1: f-1
For a total of 1 activation.
CLIPS>
I have this following rule in my CLIPS file:
(defrule check-final (declare (salience 12))
?scnt <- (set-count (value ?v) (class ?c))
(test (= ?v ?*total*))
=>
(printout T ?*total* " == " ?v crlf)
)
And I get the following strange output:
CLIPS>(run)
14 == 9
5 == 2
How is this possible ????
Pattern matching for this rule occurs whenever the fact set-count is asserted or modified. The rule is fired some time afterwards, during the call to run. These two processes can be widely separated in time. The value of ?*v* can of course change during that long period of time.
The key is to realize that he printed results will reflect the value of ?v from the the epoch during which pattern matching happened, while ?*total* will be the value when the results are printed. Since ?*total* may have seen arbitrary changes since the pattern matching, there's no guarantee that it will be equal to ?v when the rule actually fires.
Found part of the problem: I'm using the global ?*total* and according to the
CLIPS Manual
Global variables can be accessed as part of the pattern‑matching
process, but changing them does not invoke the pattern‑matching
process.
But this does not explain the equality test failure
The most likely explanation is that at some point the equality test is being satisfied and then the value of the global is changed before the rule executes.
CLIPS> (deftemplate set-count (slot value) (slot class))
CLIPS>
(defglobal ?*total* = 0)
CLIPS>
(defrule check-final (declare (salience 12))
?scnt <- (set-count (value ?v) (class ?c))
(test (= ?v ?*total*))
=>
(printout T ?*total* " == " ?v crlf)
)
CLIPS> (bind ?*total* 9)
9
CLIPS> (assert (set-count (value 9) (class a)))
<Fact-1>
CLIPS> (bind ?*total* 14)
14
CLIPS> (run)
14 == 9
CLIPS> (bind ?*total* 2)
2
CLIPS> (assert (set-count (value 2) (class b)))
<Fact-2>
CLIPS> (bind ?*total* 5)
5
CLIPS> (run)
5 == 2
CLIPS>
I have to define a variadic function in Scheme that takes the following form: (define (n-loop procedure [a list of pairs (x,y)]) where the list of pairs can be any length.
Each pair specifies a lower (inclusive) and upper bound (exclusive). That is, the following function call: (n-loop (lambda (x y) (inspect (list x y))) (0 2) (0 3)) produces:
(list x y) is (0 0)
(list x y) is (0 1)
(list x y) is (0 2)
(list x y) is (1 0)
(list x y) is (1 1)
(list x y) is (1 2)
Now, I had posted on this topic one previous time and was helped wonderfully. However, I have been given new guidelines to adhere to. The solution is to be found using nested maps only.
The way I've been going about this is as follows: find all of the values specified by the first set of bounds (in the example, (0 1 2)). This can be done by a function called (enumerate lowBound highBound). Then, I need to take each of those numbers, and cons each number in the next set of bounds (0 1 2 3), resulting in ((0 0) (0 1) (0 2) (0 3) (1 0)...).
What I've written to this point is the following:
(define (n-loop op . pairs)
(apply op (generate pairs))
)
(define (generate pairs)
(map (lambda (x) (cons x (generate (cdr pairs))))
(map (lambda (x) (enumerate (car x) (cadr x))) pairs))
)
But for the given numbers, this outputs (0 1 0 1 2 0 1 2 0 1 2) when I need ((0 0) (0 1) (0 2) (0 3) (1 0)...). This is a nasty problem. Does anyone have any insight?
This problem is more complex than you seem to realize. In particular, generating the cartesian product of an arbitrary list of ranges needs far more work - have you tried your procedure with more than two ranges? It piqued my interest, this time I'll give my shot to a complete solution, using only procedures defined for the solution, simple operations over lists (cons, car, cdr, append), lambda, apply and map.
First, the helper procedures from simplest to hardest. We need a way to generate a range of numbers. If available, use build-list or for-list, but if you need to implement it from scratch:
(define (enumerate low high)
(if (>= low high)
'()
(cons low
(enumerate (add1 low) high))))
Now we need a mechanism for folding (reducing, accumulating) the values in a list. If available use foldr, otherwise implement it like this:
(define (reduce proc lst init)
(if (null? lst)
init
(proc (car lst)
(reduce proc (cdr lst) init))))
To avoid unnecessary nesting in lists, use a flatmap - a procedure that both maps and flattens a list of values:
(define (flatmap proc lst)
(reduce (lambda (e acc)
(append (proc e) acc))
lst '()))
This is the core of the solution - a procedure that generates the cartesian product of an arbitrarily long list of lists of values denoting ranges:
(define (product . args)
(reduce (lambda (pool result)
(flatmap (lambda (x)
(map (lambda (y)
(cons x y))
result))
pool))
args
'(())))
Finally, the procedure in the question. It uses the helper procedures defined above, noticing that the op received can have an arbitrary number of parameters (depending on the number of ranges specified), so we need to use apply on each generated tuple of values:
(define (n-loop op . pairs)
(map (lambda (tuple) (apply op tuple))
(apply product
(map (lambda (pair)
(enumerate (car pair) (cadr pair)))
pairs))))
Test it like this:
(n-loop (lambda (x y z) (list x y z))
'(0 2) '(0 3) '(4 6))
> '((0 0 4) (0 0 5) (0 1 4) (0 1 5) (0 2 4) (0 2 5)
(1 0 4) (1 0 5) (1 1 4) (1 1 5) (1 2 4) (1 2 5))