How can I execute a rule for each fact only one time?
(defrule clean
?li<-(VISUAL::removedLine ?line)
?cr<-(point (x ?px) (y ?py &: (< ?py ?line)))
=>
(modify ?cr (x ?px) (y (+ 1 ?py))))
When I execute this rule and make modify it will create a new point and execute the rule for that new point too.
For example:
point (x 1) (y 2)
execute rule
point (x 1) (y 3)
execute rule
point (x 1) (y4)
I just want to make it execute one time, like this:
point (x 1) (y 2)
execute rule
point (x 1) (y 3)
Another Tetris player? :-)
Anyway, you have to use
(defrule clean
(declare (no-loop TRUE))
?li<-(VISUAL::removedLine ?line)
Related
I've tried to get a vectorfunction like
syms x
fn=function_handle([x^2;1])
Output is #(x) [x.^2;1]
Thats leads of course in an error while calling fn with vectorarguments
(Dimensions mismatch)
Is there a way to avoid the issue?
I've tried fn=function_handle([x^2;1+0*x])
but the codeoptimation - or whatever - deletes the 0*x - term.
Any suggestions?
If you think about it, what function_handle does here is reasonable, since the scenario you require here cannot be reliably predicted in advance. So I don't think there is an obvious option to change its behaviour.
You could deal with this in a couple of ways.
One way is to treat the function handle as unvectorised, and rely on external vectorization, e.g.
f = function_handle([x^2; 1]);
[arrayfun( f, [1,2,3,4,5], 'uniformoutput', false ){:}]
Alternatively, you could introduce a symbolic helper constant c, and call f appropriately. You can also create a wrapper function that uses an appropriate default constant. Examples:
f = function_handle([x^2; c], 'vars', [x,c]);
f( [1,2,3,4,5], [1,1,1,1,1] )
g = #(x) f( x, ones(size(x)) );
g([1,2,3,4,5])
or
f = function_handle([x^2; (x+c)/x], 'vars', [x,c]);
f([1,2,3,4,5], 0)
g = #(x) f( x, 0 )
g([1,2,3,4,5])
Thank you.
Today, i'm happy of a solution i've found.
I turn the arrayfcn into a cellfcn:
f_h_Cell=#(x, y) {x .* y, 0}
nf = #(x) #mifCell2Mat (f_h_Cell (x (size (x) (1) * 0 / 2 + 1:size (x) (1) * 1 / 2,{':'} (ones (1, ndims (x) - 1)){:}), x (size (x) (1) * 1 / 2 + 1:size (x) (1) * 2 / 2, {':'} (ones (1, ndims (x) - 1)) {:})))
and then:
function res=mifCell2Mat(resCell)
resCell=transpose(resCell);
[~,idx]=max(cellfun(#numel,resCell));
refSize=(size(resCell{idx}));
resCell=cellfun(#(x) x+zeros(refSize),resCell,'uniformoutput',false);
res=cell2mat(resCell);
endfunction
All automate calling following function
f=fcn(name,domain,parms,fcn);
so a simple f.nf([x;y;z]) call gives the result.
Of course it doesn't work, if there are numel's between 1 and say size=[10,10] of
eg size=[10,1], but so what ... In most cases it work's for me (until now: allways).
Oh, while i read my code just here, i've found a little bug:
refSize=(size(resCell{idx}));
must of course change to
refSize=(size(resCell{idx(1)}));
cause there a possible more than one max sizes in the idx, so i've picked the first. I do first a test of constant outDims, so that these workaround only occours, if there are constants. In the other cases (if all outDims contain domainvars) a simple anonymous function of a matrix-handle appears to the user:
f_h_Mat=#(x, y) [x .* y; x]
nf=#(x) f_h_Mat (x (size (x) (1) * 0 / 2 + 1:size (x) (1) * 1 / 2, {':'} (ones (1, ndims (x) - 1)) {:}), x (size
(x) (1) * 1 / 2 + 1:size (x) (1) * 2 / 2, {':'} (ones (1, ndims (x) - 1)) {:}))
does anybody know how can I create a function in Scheme that takes no arguments and everytime I call it returns 0 or 1, depending on how many times it's been called? For example, the 1st time returns 1, the 2nd 0, the 3rd 1, etc.
I suppose I have to use a local variable inside the function, but I don't know exactly how, so that it changes value everytime I call it.
You didn't say how you are calling your function. Did you define some named function as the lambda you return with you make-flip function? I guess this is "making closures 101" but it's the first time I've done to my recollection. Anyway, I tried this way and it seemed to work:
(define (make-flipper)
(let ((flip 0))
(lambda ()
(set! flip (if (= flip 0) 1 0))
flip)))
(define doit (make-flipper))
(doit)
(doit)
(doit)
--results in 1, then 0, then 1. I guess you could change the value in the let if you want it to start with 0.
Your code doesn't work because you're overusing parentheses, which makes your code try to call "procedures" that aren't procedures.
Your code,
(define (make-flip)
(let ((x 1))
(lambda ()
((set! x (- 1 x))
(if (= x 0) (1) (0))))))
attempts the procedure calls (0) and (1), and it also tries to "call" the result of the sequence
(set! x (- 1 x))
(if (= x 0) (1) (0)))
(Scheme never ignores any parentheses the way some other languages do.)
If you fix those,
(define (make-flip)
(let ((x 1))
(lambda ()
(set! x (- 1 x))
(if (= x 0) 1 0))))
it works.
The conditional isn't necessary though, you can also say
(define (make-flip)
(let ((x 0))
(lambda ()
(set! x (- 1 x))
x)))
and get the same result.
If you only need one procedure of this kind, you can also do as follows:
(define flip
(let ((x 1))
(lambda ()
(begin0
x
(set! x (- 1 x))))))
Testing:
> (flip)
1
> (flip)
0
> (flip)
1
> (flip)
0
I am trying to make a helper function that will take input of switched syntax.
Helper function needs to be able to do:
> (num sqr) ; where num=6, and sqr is the math function square.
36
Originally, the built-in syntax would be:
>(sqr num) ; where num=6
36
Since I cannot declare 'num' as a function and a variable at the same time, I will need to nest another procedure into it. Below is what I have so far:
(define (num func)
(display func + 6))
Now, I know that 'display' won't easily do what I'd like it to do unlike other programming languages. Is there another method in place of 'display' that I can use? I think this is the easiest way to do it, but I am new so I'm not sure which is an appropriate method. 'func' will need to be able to take math functions like 'sqr' 'sqrt' 'add1'...etc.
If you just want (num sqr) to work like in your code you can do this:
(define (num fun)
(fun 6))
(num sqr) ; ==> 36
(num add1) ; ==> 7
But num won't be 6.
A solution might be to make yourself a module language, perhaps called #!lefthanded-racket where the parser for code just reverses all lists. Thus you can supply it code like:
#!lefthanded-racket
(6 num define)
(num sqr) ; ==> 36
(num add1) ; ==> 7
((((((1 y -) x ack) (1 x -) ack) (y x))
(2 (1 _))
((y 2 *) (y 0))
(0 (0 _))
(y x) match*)
(y x ack) define)
(4 2 ack) ; ==> 65536
For the simple solution, where you just override the default reader and deep reverse the lists you'll have problems with dotted lists. In order to get that right you need to write a parser.
The code that is run won't be in reverse, only the code you write. There is some documentation on how to create your own language. Also this practical example might be helpful too.
Do you mean something like this?
#lang racket
(define ((partial func) arg)
(func arg))
((partial sqr) 6)
The output is 36.
Quite often I need to replace subsequence of certain elements with another sequence of the same type, but, probably with different length. Implementation of such function is no challenge, this is what I use now:
(defun substitute* (new old where &key key (test #'eql))
(funcall (alambda (rest)
(aif (search old rest :key key :test test)
(concatenate (etypecase rest
(string 'string)
(vector 'vector)
(list 'list))
(subseq rest 0 it)
new
(self (subseq rest (+ it (length old)))))
rest))
where))
Works like this:
CL-USER> (substitute* '(x y) '(z) '(1 z 5 8 y z))
(1 X Y 5 8 Y X Y)
CL-USER> (substitute* "green button" "red button"
"here are red indicator, red button and red wire")
"here are red indicator, green button and red wire"
CL-USER> (substitute* #(4) #(2 2) #(2 2 2 2 2))
#(4 4 2)
You see, it's very handy and useful, so I've feeling that I'm reinventing wheel and it must be in the standard library, I just don't know its name (sometimes names are not obvious, you may search for filter while what you need is set-difference).
As a result of compromise between clarity and efficiency:
(defun substitute* (new old where &key key (test #'eql))
(let ((type (etypecase where
(string 'string)
(vector 'vector)
(list 'list)))
(new (coerce new 'list))
(old (coerce old 'list))
(where (coerce where 'list)))
(coerce (funcall (alambda (rest)
(aif (search old rest :key key :test test)
(append (remove-if (constantly t) rest :start it)
new
(self (nthcdr (+ it (length old)) rest)))
rest))
where)
type)))
I don't think that there's any standard function for this. It's more complicated than the standard replace family of functions. Those can operate destructively because you know in advance that you can replace element by element. Even in that case, it's still somewhat difficult to do this efficiently, because the access time for lists and vectors is very different, so general-purpose functions like subseq can be problematic. As Rainer Joswig pointed out in a comment:
It's kind of unfortunate that for many algorithms over sequences there
is no single efficient implementation. I see often that there are two
versions, one for lists and one for vectors, which then get hidden
behind a dispatching function. For a hack a simple common version is
fine, but for a library function, often there are different
implementations - like shown here.
(In fact, in doing a bit of research on whether some library contains a function for this, one of the first Google results I got was a question on Code Review, Generic sequence splitter in Common Lisp, in which Rainer and I both had some comment similar to those here.)
A version for lists
However, your implementation is rather inefficient because it makes multiple copies of the the remainders of sequences. E.g., when you replace (z) in (1 z 2 z 3 z), with (x y), you'll first make (3 x y), then copy it in making (2 x y 3 z y), and then you'll copy that in making (1 x y 2 x y 3 x y). You might be better off in doing one pass over the sequence, determining the indices of the subsequences to replace, or collecting the bits that need to don't need to be replaced, etc. You'll probably want separate implementations for lists and for other sequences. E.g., with a list, you might do:
(defun splice-replace-list (old new list)
(do ((new (coerce new 'list))
(old-len (length old))
(parts '()))
((endp list)
(reduce 'append (nreverse parts) :from-end t))
(let ((pos (search old list)))
(push (subseq list 0 pos) parts)
(cond
((null pos)
(setf list nil))
(t
(push new parts)
(setf list (nthcdr (+ old-len pos) list)))))))
There are some optimizations you could make here, if you wanted. For instance, you could implement a search-list that, rather than returning the position of the first instance of the sought sequence, could return a copy of the head up until that point and the tail beginning with the sequence as multiple values, or even the copied head, and the tail after the sequence, since that's what you're really interested in, in this case. Additionally, you could do something a bit more efficient than (reduce 'append (nreverse parts) :from-end t) by not reversing parts, but using a reversed append. E.g.,
(flet ((xappend (l2 l1)
(append l1 l2)))
(reduce #'xappend '((5 6) (x y) (3 4) (x y))))
;=> (x y 3 4 x y 5 6)
I wrote this in a somewhat imperative style, but there's no reason that you can't use a functional style if you want. Be warned that not all Lisp implementation support tail call optimization, so it might be better to use do, but you certainly don't have to. Here's a more functional version:
(defun splice-replace-list (old new list)
(let ((new-list (coerce new 'list))
(old-len (length old)))
(labels ((keep-going (list parts)
(if (endp list)
(reduce 'append (nreverse parts) :from-end t)
(let* ((pos (search old list))
(parts (list* (subseq list 0 pos) parts)))
(if (null pos)
(keep-going '() parts)
(keep-going (nthcdr (+ old-len pos) list)
(list* new-list parts)))))))
(keep-going list '()))))
A version for vectors
For non lists, this is more difficult, because you don't have the specific sequence type that you're supposed to be using for the result. This is why functions like concatenate require a result-type argument. You can use array-element-type to get an element type for the input sequence, and then use make-array to get a sequence big enough to hold the result. That's trickier code, and will be more complicated. E.g., here's a first attempt. It's more complicated, but you'll get a result that's pretty close to the original vector type:
(defun splice-replace-vector (old new vector &aux (new-len (length new)))
(flet ((assemble-result (length parts)
(let ((result (make-array length :element-type (array-element-type vector)))
(start 0))
(dolist (part parts result)
(cond
((consp part)
(destructuring-bind (begin . end) part
(replace result vector :start1 start :start2 begin :end2 end)
(incf start (- end begin))))
(t
(replace result new :start1 start)
(incf start new-len)))))))
(do ((old-len (length old))
(total-len 0)
(start 0)
(indices '()))
((null start) (assemble-result total-len (nreverse indices)))
(let ((pos (search old vector :start2 start)))
(cond
((null pos)
(let ((vlength (length vector)))
(push (cons start vlength) indices)
(incf total-len (- vlength start))
(setf start nil)))
(t
(push (cons start pos) indices)
(push t indices)
(incf total-len (- pos start))
(incf total-len new-len)
(setf start (+ pos old-len))))))))
CL-USER> (splice-replace-vector '(#\z) '(#\x #\y) "12z")
"12xy"
CL-USER> (splice-replace-vector '(z) '(x y) #(x y))
#(X Y)
CL-USER> (splice-replace-vector '(z) '(x y) #(1 z 2 z 3 4 z))
#(1 X Y 2 X Y 3 4 X Y)
CL-USER> (splice-replace-vector '(#\z) #(#\x #\y) "1z2z34z")
"1xy2xy34xy"
If you only want to make one pass through the input vector, then you could use an adjustable array as the output, and append to it. An adjustable array will have a bit more overhead than a fixed size array, but it does make the code a bit simpler.
(defun splice-replace-vector (old new vector)
(do ((vlength (length vector))
(vnew (coerce new 'vector))
(nlength (length new))
(result (make-array 0
:element-type (array-element-type vector)
:adjustable t
:fill-pointer 0))
(start 0))
((eql start vlength) result)
(let ((pos (search old vector :start2 start)))
(cond
;; add the remaining elements in vector to result
((null pos)
(do () ((eql start vlength))
(vector-push-extend (aref vector start) result)
(incf start)))
;; add the elements between start and pos to the result,
;; add a copy of new to result, and increment start
;; accordingly
(t
;; the copying here could be improved with adjust-array,
;; and replace, instead of repeated calls to vector-push-extend
(do () ((eql start pos))
(vector-push-extend (aref vector start) result)
(incf start))
(loop for x across vnew
do (vector-push-extend x result))
(incf start (1- nlength)))))))
A “generic” version
Using these two functions, you could define a general splice-replace that checks the type of the original input sequence and calls the appropriate function:
(defun splice-replace (old new sequence)
(etypecase sequence
(list (splice-replace-list old new sequence))
(vector (splice-replace-vector old new sequence))))
CL-USER> (splice-replace #(z) '(x y) #(1 z 2 z 3 4 z))
#(1 X Y 2 X Y 3 4 X Y)
CL-USER> (splice-replace '(z) #(x y) '(1 z 2 z 3 4 z))
(1 X Y 2 X Y 3 4 X Y)
I can't seem to make the correct outcome, but I don't know how to set up my nth value any way else... It does the 0th and 1st derivative correctly then it gives me a crazy negative number.. do you know what could be the problem?
Code:
(define (der f h)
(lambda (x) (/ (- (f (+ x h)) (f x))
h)
)
)
(define (cube x) (* x x x))
(define (many-der f h n)
(if (= n 0)
f
(many-der (der f h) h (- n 1))))
(define der-of-cube-n (many-der cube .00000000000001 2))
(der-of-cube-n 5)
-142108547152020.03
I've attempted to rearange it so then the else statement starts with der but I get the same output when n=2...
Any help would be greatly appreciated!!
Your h of .00000000000001 is too small; so small that you are running into rounding errors. Here is a result with another h
(define der-of-cube-n (der-n cube 0.0001 2))
> (der-of-cube-n 5)
30.000597917023697
Note: second derivative of x^3 is 6x.
Of course, one of the important attributes of Scheme is that it supports exact numbers of arbitrary precision. So if you really want h to be that small you can formulate your inputs to be 'exact'. Like this:
> (define der-of-cube-n (der-n cube (/ 10000000000000) 2))
> (der-of-cube-n 5)
150000000000003/5000000000000
> (rationalize (der-of-cube-n 5) 0.01)
3e1