I'm trying to report the inference steps in JESS. For example, I would like to know which rules/facts caused inference engine to fire a certain rule. In order words, I want to see the theorem proving capabilities of JESS.
Here is an example from Wikipedia:
(defrule A ""
(and (X croaks) (X eats flies))
=>
(assert (X is a frog))
)
(defrule B ""
(and (X chirps) (X sings))
=>
(assert (X is a canary))
)
(defrule C ""
(X is a frog)
=>
(assert (X is green))
)
(defrule D ""
(X is a canary)
=>
(assert (X is yellow))
)
If I have the following:
(assert (X croaks))
(assert (X eats flies))
Then when I enter (run) then I will have rule C fired. It seems like, it's fired because of
(X is a frog)
but actually because of
(and (X croaks) (X eats flies))
I am not sure if I'm clear, but I wonder if there is any way that I can show why a certain rules is fired with a comlete inference process.
You'll have to write some Java code, implementing jess.JessListener. You attach an object of this class to the Rete object, using Rete.addJessListener(jess.JessListener). The event you are interesting in is JessEvent.DEFRULE_FIRED, and it'll contain a reference to the activation object, and the rule is available from that.
See the Javadoc for JessListener for some Java code.
You can attach the listener from CLP code, prior to (run).
Related
I don't know of any practical uses for this, it just came to my mind whether there is any thing comparable to defmethod to defun for lambda? Something like this
(defmacro tlambda (args &body body)
(let* ((gf-name (subseq (write-to-string (gensym)) 2))
(gf-sym (read-from-string gf-name)))
`(progn (defmethod ,gf-sym ,args ,#body)
(prog1 (symbol-function ',gf-sym) (unintern ',gf-sym)))))
(tlambda ((x fixnum))) ;#<STANDARD-GENERIC-FUNCTION #:G759 (1)>
(funcall (tlambda ((x fixnum)) (* x 2)) 4) ;8
(funcall (tlambda ((x list)) (second x)) '(a s d f)) ;S
(funcall (tlambda ((x string)) (string-upcase x)) "lambda") ;"LAMBDA"
I do not think that this makes sense in the shape you show. What should happen if the type doesn't match? If you just want to check types, use check-type.
Defmethod and defun are not really comparable, by the way. Defun registers a function, while defmethod adds a method to an existing (though maybe implicitly created) generic function. The types that you use in a method definition are used to dispatch (runtime polymorphism) to the right method upon invocation of the generic function. The mechanisms for this dispatch are a bit expensive when constructed, so you probably shouldn't try to do that on the fly (something like a generic-lambda) or transiently (something like a method-let).
Instead, use (e/c)typecase and similar for ad hoc dispatch, and check-type for checking types. There are also libraries for pattern-based polymorphism (e. g. optima, trivia), which you could use for more elaborate cases.
I agree with Svante that you probably don't want this. But if you did want it the way you are doing it is very confused: I simply don't understand what you are doing with gf-sym and gf-name but it represents some quite serious confusion about symbols I think (and is almost certainly unsafe). Instead you could do something like this:
(defmacro tlambda (&body cases)
(let* ((gf-name (gensym)))
`(progn
,#(mapcar (lambda (case)
`(defmethod ,gf-name ,#case))
cases)
(symbol-function ',gf-name))))
And now
> (let ((l (tlambda
((x y) (cons x y))
((x (y integer))
(declare (ignore x)) y))))
(values (funcall l 'a 'b)
(funcall l 'a 1)))
(a . b)
1
I'm not sure whether the objects created by tlambda can be garbage-collected: it may be they can.
I've got a bit exotic situation. I need to compare functions, but rather by their "origin" than by "instances". Here what I actually mean:
(define-values (a b c d) (values #f #f #f #f))
(define (f x)
(let ([g (λ (y) (printf "Please tell ~a this is ~a\n" x y))]
[h (curry printf "Don't tell ~a this is ~a\n" x)])
(if a
(set! b g)
(set! a g))
(if c
(set! d h)
(set! c h))))
(f "me")
(f " me")
(a "possible")
(d "impossible")
(equal? a b) ; <==== Is it possible to compare these guys
(equal? c d) ; <==== to get #t in both cases?
In both cases we get two different "instances" of functions (even with different values captured), but both declared in the same location of the source code. Of course, getting the actual text of the body of those functions will solve the problem, but other answers here on SO tell that this is impossible in Racket. Are there some tricks that can help me?
Edit:
This is not the question on theoretical equivalence of functions. This is completely technical question, much rather on Racket's functions representation in a compiled code. So it can be reformulated, for example, in a following way: can I get the line number of some routine from 'user' code? I suppose this should be feasible because Racket debugger somehow obtains it.
It can be done even without support from racket internals if you control the code that makes the functions. If you keep a counter (or some identifier) that will denote the particular lambda it can wrap different closures in a struct that can have the same identity from macro expansion. Here is a demonstration:
#lang racket
;; makes a procedure object that can have other data connected to it
(struct proc (id obj)
#:property prop:procedure
(struct-field-index obj)
#:methods gen:custom-write
[(define (write-proc x port mode)
(display (format "#<procedure-id-~a>" (proc-id x)) port))])
;; compares the ids of two proc objects if they are proc objects
(define (proc-equal? a b)
(and (proc? a)
(proc? b)
(= (proc-id a) (proc-id b))))
;; extends equal?, candidate to provide
(define (equal*? a b)
(or (proc-equal? a b)
(equal? a b)))
;; the state we keep
(begin-for-syntax
(define unique-proc-id-per-code 0))
;; a macro that changes (lambda* ...) to
;; (proc expansion-id (lambda ...))
(define-syntax (lambda* stx)
(let ((proc-id unique-proc-id-per-code))
(set! unique-proc-id-per-code (add1 unique-proc-id-per-code))
#`(proc #,(datum->syntax stx proc-id) (lambda #,#(datum->syntax stx (cdr (syntax-e stx)))))))
;; test with making a counter
(define counter-from
(lambda* (from)
(lambda* ()
(begin0
from
(set! from (add1 from))))))
;; evaluatin the outer shows it has id 0
counter-from ; ==> #<procedure-id-0>
;; make two counters that both use the inner lambda
(define from10 (counter-from 10))
(define from20 (counter-from 20))
;; both have the same expansion id
from10 ; ==> #<procedure-id-1>
from20 ; ==> #<procedure-id-1>
;; they are not equal?
(equal? from10 from20) ; ==> #f (different object instances of proc)
;; but they are procedure-equal?
(proc-equal? from10 from20) ; ==> #t (same id, thus came from same macroexpansion)
Disclaimer: I'm more a schemer than a racketeer so this could perhaps have been done more elegantly and I have no idea what performance penalties this will give.
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)
Ok, about Monad, I am aware that there are enough questions having been asked. I am not trying to bother anyone to ask what is monad again.
Actually, I read What is a monad?, it is very helpful. And I feel I am very close to really understand it.
I create this question here is just to describe some of my thoughts on Monad and Function, and hope someone could correct me or confirm it correct.
Some answers in that post let me feel monad is a little bit like function.
Monad takes a type, return a wrapper type (return), also, it can take a type, doing some operations on it and returns a wrapper type (bind).
From my point of view, it is a little bit like function. A function takes something and do some operations and return something.
Then why we even need monad? I think one of the key reasons is that monad provides a better way or pattern for sequential operations on the initial data/type.
For example, we have an initial integer i. In our code, we need to apply 10 functions f1, f2, f3, f4, ..., f10 step by step, i.e., we apply f1 on i first, get a result, and then apply f2 on that result, then we get a new result, then apply f3...
We can do this by functions rawly, just like f1 i |> f2 |> f3.... However, the intermediate results during the steps are not consistent; Also if we have to handle possible failure somewhere in middle, things get ugly. And an Option anyway has to be constructed if we don't want the whole process fail on exceptions. So naturally, monad comes in.
Monad unifies and forces the return types in all steps. This largely simplifies the logic and readability of the code (this is also the purpose of those design patterns, isn't it). Also, it is more bullet proof against error or bug. For example, Option Monad forces every intermediate results to be options and it is very easy to implement the fast fail paradigm.
Like many posts about monad described, monad is a design pattern and a better way to combine functions / steps to build up a process.
Am I understanding it correctly?
It sounds to me like you're discovering the limits of learning by analogy. Monad is precisely defined both as a type class in Haskell and as a algebraic thing in category theory; any comparison using "... like ..." is going to be imprecise and therefore wrong.
So no, since Haskell's monads aren't like functions, since they are 1) implemented as type classes, and 2) intended to be used differently than functions.
This answer is probably unsatisfying; are you looking for intuition? If so, I'd suggest doing lots of examples, and especially reading through LYAH. It's very difficult to get an intuitive understanding of abstract things like monads without having a solid base of examples and experience to fall back on.
Why do we even need monads? This is a good question, and maybe there's more than one question here:
Why do we even need the Monad type class? For the same reason that we need any type class.
Why do we even need the monad concept? Because it's useful. Also, it's not a function, so it can't be replaced by a function. (Your example seems like it does not require a Monad (rather, it needs an Applicative)).
For example, you can implement context-free parser combinators using the Applicative type class. But try implementing a parser for the language consisting of the same string of symbols twice (separated by a space) without Monad, i.e.:
a a -> yes
a b -> no
ab ab -> yes
ab ba -> no
So that's one thing a monad provides: the ability to use previous results to "decide" what to do. Here's another example:
f :: Monad m => m Int -> m [Char]
f m =
m >>= \x ->
if x > 2
then return (replicate x 'a')
else return []
f (Just 1) -->> Just ""
f (Just 3) -->> Just "aaa"
f [1,2,3,4] -->> ["", "", "aaa", "aaaa"]
Monads (and Functors, and Applicative Functors) can be seen as being about "generalized function application": they all create functions of type f a ⟶ f b where not only the "values inside a context", like types a and b, are involved, but also the "context" -- the same type of context -- represented by f.
So "normal" function application involves functions of type (a ⟶ b), "generalized" function application is with functions of type (f a ⟶ f b). Such functions can too be composed under normal function composition, because of the more uniform types structure: f a ⟶ f b ; f b ⟶ f c ==> f a ⟶ f c.
Each of the three creates them in a different way though, starting from different things:
Functors: fmap :: Functor f => (a ⟶ b) ⟶ (f a ⟶ f b)
Applicative Functors: (<*>) :: Applicative f => f (a ⟶ b) ⟶ (f a ⟶ f b)
Monadic Functors: (=<<) :: Monad f => (a ⟶ f b) ⟶ (f a ⟶ f b)
In practice, the difference is in how do we get to use the resulting value-in-context type, seen as denoting some type of computations.
Writing in generalized do notation,
Functors: do { x <- a ; return (g x) } g <$> a -- fmap
Applicative do { x <- a ; y <- b ; return (g x y) } g <$> a <*> b
Functors: (\ x -> g x <$> b ) =<< a
Monadic do { x <- a ; y <- k x ; return (g x y) } (\ x -> g x <$> k x) =<< a
Functors:
And their types,
"liftF1" :: (Functor f) => (a ⟶ b) ⟶ f a ⟶ f b -- fmap
liftA2 :: (Applicative f) => (a ⟶ b ⟶ c) ⟶ f a ⟶ f b ⟶ f c
"liftBind" :: (Monad f) => (a ⟶ b ⟶ c) ⟶ f a ⟶ (a ⟶ f b) ⟶ f c
I read about SAT and SMT. I always wonder how it can be applied in real programming scenario.
Here is an example:
Given that var a = 20; var b = a; are true, we want to know if b = 20 is true or false.
How should I turn it into boolean algebra expressions and apply SAT?
Here is the simplest example using SMT-LIB 2.0 standard supported by many SMT solvers:
(declare-fun a () Int)
(declare-fun b () Int)
(assert (= a b))
(assert (= a 20))
(assert (= b 20))
(check-sat)
You can use http://rise4fun.com/z3 to experiment with it. It will respond "sat" meaning the assertions can be satisfied, meaning then b can be 20.
Then you can replace (assert (= b 20)) with (assert (distinct b 20)). Z3 will respond with "unsat" meaning it's not possible for b to be anything else.