Hello,
I am a LISP beginner having trouble with a program I am writing.
The basic idea is when I run it as (prover 'L), I expect to see something
like:
((L)((B)(A)), symbolizing L is implied by B & A. However, only B gets
returned. Somewhere along the way A is getting absorbed by, probably an OR
function. The algorithm does process the A case as well. I traced it. But
where the record of it gets lost, I can't figure out.
The code presented is a simple inference engine that is supposed to return
nil if the simple proposition offered to it cannot be proven true using the
facts or rules known to the application, or print a trace of how it was
proven true. As you will see when you run it it does not quite do it. Some
tokens get lost. It seems like only the last of the sequence that makes the
proposition true survives the ordeal. So, out of expected A and B, as
mentioned above, only B comes out of this alive
rules have form FIRST is implied by SECOND [&THIRD[&FOURTH[...]]];
Thus ( p q x) would mean x&q -> p
Thank you for your assistance.
Alex.
Code:
(defvar *rules* '((q p)(p l m)(m b l)(l a p)(l a b)))
(defvar *facts* '(a b))
(defvar *search-stack* nil)
(defun prove(x)(cond
((or(numberp x)(and(not(atom x))(not(or(eq(second x) 'rules)(eq (second x)
'facts))))) "only simple non-constant propositional statements are allowed")
(t
;if it is an atom and not a number, ensure that it is neither nil nor t.
(cond
((or (null x)(eq t x)) x)
((listp x)
(defun kilnil(y)(cond((eq y nil)y)(t (cond((eq nil(first y))(kilnil(rest
y)))(t(append(list(first y))(kilnil(rest y))))))))
(defun push(y)(setq *search-stack* (append(list y) *search-stack*)))
(defun pop()(setq *search-stack* (rest *search-stack*)))
(defun is-it(v w)(cond ((null w) nil)(t (cond ((eq v (first w)) v)(t
(is-it v (rest w))) )) ))
(defun is-on-stack(y)(is-it y *search-stack*))(print x)
(cond
((eq (second x) 'facts)(kilnil (mapcar #'(lambda(y)(if(eq(first x)y) y))
*facts*)))
((eq (second x) 'rules)(kilnil(mapcar #'(lambda(y)(cond((eq (first
x)(first y))
(mapcar #'(lambda(z)(cond((not(is-on-stack z))(push z)(setq tmp
(kilnil(prove z)))(pop)tmp) ))(rest y))
))) *rules*))
)
))
(t
(setq f (prove (append (list x)(list 'facts))))
(cond
((not f)
(setq *search-stack* (append(list x) *search-stack*))
(setq l(prove (append (list x)(list 'rules))))
(setq *search-stack* (rest *search-stack*))
l)
(t f))
)
))))
In article <··············@corp.supernews.com>,
"Alex Parshikov" <··········@nowhere.com> wrote:
> Hello,
>
> I am a LISP beginner having trouble with a program I am writing.
First task: reformat your code that it is readable and then
post again.
Hello,
Your code is really hard to understand the way it is formatted. I
think that makes it harder for you to get it right.
I have re-written your code extensively. This is to put it in the
style of modern Common Lisp, as well as using more of the Lisp
features rather than writing them yourself. I won't say that this is
"the way" you should write your code, but I hope it's a better example
of Lisp style.
The code sort of works. I don't like the way its output looks, but it
does seem to prove things. All the "tokens" seem to stay on the
output list. However, the initial token doesn't. I think you have to
do something more sophisticated to manage your output.
(defvar *rules* '((q p) (p l m) (m b l) (l a p) (l a b)))
(defvar *facts* '(a b))
(defvar *search-stack* nil)
;;; Pull out the "nested" defuns. If you really want to nest your
;;; functions, use "flet" or "labels". The code looks cleaner the way
;;; it is below, and if you're having trouble this is probably the way
;;; to go for now.
;;; Also, you notice I used built-in features to do what your code was
;;; doing. This is less error prone and a lot easier to understand.
(defun kilnil (y)
(remove nil y)) ; Don't re-invent the wheel.
(defun spush (y)
(push y *search-stack*)) ; Don't re-invent the wheel.
(defun spop()
(pop *search-stack*)) ; Don't re-invent the wheel.
(defun is-it (v w)
(find v w)) ; Don't re-invent the wheel.
(defun is-on-stack (y)
(is-it y *search-stack*))
(defun prove (x)
;; I believe in using "when" or "unless" when there is only one
;; clause, and "if" when there are two. I use "cond" for
;; multiple clauses.
(when (or (numberp x)
(and (not (atom x))
(not (or (eq (second x) 'rules)
(eq (second x) 'facts)))))
;; If it's an error, just call it an error and exit.
(error "only simple non-constant propositional statements are allowed"))
(cond ((or (null x) (eq t x))
x)
((listp x)
(print x)
(cond ((eq (second x) 'facts)
(kilnil (mapcar #'(lambda (y)
(when (eq (first x) y) y))
*facts*)))
((eq (second x) 'rules)
(kilnil (mapcar #'(lambda (y)
(when (eq (first x) (first y))
(mapcar #'(lambda (z)
(unless (is-on-stack z)
;; prog2 avoids the need for a temporary variable.
(prog2
(spush z)
(kilnil (prove z))
(spop))))
(rest y))))
*rules*)))))
(t
;; Using setq often isn't necessary, and it's bad style to
;; use it without defining the variable you're assigning to.
(let ((f (prove (cons x (list 'facts)))))
(if f
f
;; The following does almost exactly the same thing as
;; some earlier code but it was written differently.
;; This makes things confusing so I made it like the
;; other code.
;;
;; prog2 avoids the need for a temporary variable.
(prog2
(spush x)
(prove (cons x (list 'rules)))
(spop)))))))
I hope this helps.
--
Fred Gilham ······@csl.sri.com
"...If reason is no longer a faculty enabling us to discern some
cosmic design, then it is no longer clear what claim reason has upon
us, or upon our politics. On the contrary, the sorts of habits that we
associate with `reasoning' --- that is, reflecting and discussing and
trying to achieve some kind of coherence among our various opinions
--- can come to seem like nothing more than the mental preferences (or
prejudices) of a particular class of people --- the dogmatic
proceduralism of an educated elite." --- Steven D. Smith
Hey Alex,
Here's a bit of a re-write for you. I hope it will be easy to
understand. The return value of prove is the member of *rules* that
succeeded. So, (prove 'l) will return (l a b).
(defvar *rules* '((q p) (p l m) (m b l) (l a p) (l a b)))
(defvar *facts* '(a b))
(defvar *search-stack* nil)
(defun prove-facts (x)
(find x *facts*))
(defun prove-rules (x)
(find-if #'(lambda (rule)
(and (eq (car rule) x)
(every #'prove (cdr rule))))
*rules*))
(defun prove (x)
(unless (member x *search-stack*)
(prog2 (push x *search-stack*)
(or (prove-facts x)
(prove-rules x))
(pop *search-stack*))))
Good luck with your project.
Justin Dubs
"Alex Parshikov" <··········@nowhere.com> writes:
> Hello,
>
> I am a LISP beginner having trouble with a program I am writing.
> [...]
> Thank you for your assistance.
I read this night the FAQ of this newsgroup, it was interesting and I
would suggest you do too.
Instead of (kilnil(mapcar, you may want to try (mapcan
There are alreayd pop and push in Common-Lisp. It's not allowed to
redefined Common-Lisp symbol. The pop and push of Common-Lisp may
serve you as well as yours.
append is O(n). It's better to avoid it if you can. For example:
(append(list x) *search-stack*) --> (cons x *search-stack*)
(append (list x)(list 'facts)) --> (list x 'facts)
> Alex.
>
>
> Code:
>
> (defvar *rules* '((q p)(p l m)(m b l)(l a p)(l a b)))
> (defvar *facts* '(a b))
> (defvar *search-stack* nil)
>
> (defun prove(x)(cond
> ((or(numberp x)(and(not(atom x))(not(or(eq(second x) 'rules)(eq (second x)
> 'facts))))) "only simple non-constant propositional statements are allowed")
> (t
> ;if it is an atom and not a number, ensure that it is neither nil nor t.
> (cond
> ((or (null x)(eq t x)) x)
> ((listp x)
> (defun kilnil(y)(cond((eq y nil)y)(t (cond((eq nil(first y))(kilnil(rest
> y)))(t(append(list(first y))(kilnil(rest y))))))))
> (defun push(y)(setq *search-stack* (append(list y) *search-stack*)))
> (defun pop()(setq *search-stack* (rest *search-stack*)))
> (defun is-it(v w)(cond ((null w) nil)(t (cond ((eq v (first w)) v)(t
> (is-it v (rest w))) )) ))
> (defun is-on-stack(y)(is-it y *search-stack*))(print x)
> (cond
> ((eq (second x) 'facts)(kilnil (mapcar #'(lambda(y)(if(eq(first x)y) y))
> *facts*)))
> ((eq (second x) 'rules)(kilnil(mapcar #'(lambda(y)(cond((eq (first
> x)(first y))
> (mapcar #'(lambda(z)(cond((not(is-on-stack z))(push z)(setq tmp
> (kilnil(prove z)))(pop)tmp) ))(rest y))
> ))) *rules*))
> )
> ))
> (t
> (setq f (prove (append (list x)(list 'facts))))
> (cond
> ((not f)
> (setq *search-stack* (append(list x) *search-stack*))
> (setq l(prove (append (list x)(list 'rules))))
> (setq *search-stack* (rest *search-stack*))
> l)
> (t f))
> )
> ))))
>
>
--
__Pascal_Bourguignon__ http://www.informatimago.com/
----------------------------------------------------------------------
Do not adjust your mind, there is a fault in reality.
Pascal Bourguignon wrote:
> append is O(n). It's better to avoid it if you can. For example:
> (append(list x) *search-stack*) --> (cons x *search-stack*)
> (append (list x)(list 'facts)) --> (list x 'facts)
To be more precise: (APPEND X Y) takes time proportional
to the length of X. So the particular cases above don't
suffer a greater-than-constant slowdown from using APPEND.
You're right that they should be rewritten as you suggest,
but the main reason is clarity rather than efficiency. :-)
--
Gareth McCaughan ················@pobox.com
.sig under construc