I am trying to create a lisp function that evaluates and simplifies multiplication and addition arithmetic.
The function should work such that when the user calls a function
(simplify-Mult'(* 1 2)) it prints just 2 or
(simplify-Mult '(*0 3 3 7)) prints just 0.
So far I have this
(defun simplify-multiplication (lis)
(if (not (null lis))
(if (member '0 lis) 0
(if (member '1 lis) cdr lis
(if (listp (car lis))
(cons(simplify(car lis)))
(if (numberp (car lis))
(if (null (cdr lis))
lis
(cons (car lis) (simplify-multiplication (cdr lis)))
)
(if (eq (car lis) '+)
(cons (car lis) (simplify-multiplication (cdr lis)))
(if (eq (car lis) '*)
(cons (car lis) (simplify-multiplication (cdr lis)))
lis
)
)
)
)
)
)
)
)
You can write one single function simplify which applies the simplification rules for both multiplication and addition. If you want to recursively simplify an expression, first you have to simplify each one of the arguments and then apply the simplification rules for the corresponding operation.
The following could be a starting point:
(defun simplify (lis)
(if (atom lis)
lis
(let ((args (mapcar #'simplify (cdr lis))))
(cond
((eql (car lis) '+)
(setq args (remove 0 args))
(case (length args)
(0 0)
(1 (car args))
(otherwise (cons '+ args)) ))
((eql (car lis) '*)
(if (member 0 args)
0
(progn
(setq args (remove 1 args))
(case (length args)
(0 1)
(1 (car args))
(otherwise (cons '* args)) ))))
(T (cons (car lis) args)) ))))
You would probably want to add other simplification rules, such as (* 2 (* 3 4)) => (* 2 3 4), etc.. as well as detecting wrong expressions such as (simplify '(+)).
Related
I'm trying to teach myself Racket. I'm currently trying to write a function to help understand nested lists. The function takes a nested list and a procedure and applies the procedure to each element to produce a new list. An example:
(map-tree even? '(1 2 3 4)) => '(#f #t #f #t)
Here's what I've got so far:
(define (map-tree proc tree)
(map-tree-aux tree proc '() ))
(define (map-tree-aux tree proc lst)
(if (null? tree)
lst
(if (list? tree)
(if (null? (cdr tree))
(if (number? (car tree))
(map-tree-aux (car tree) proc (append-end (proc (car tree)) lst))
(map-tree-aux (car tree) proc lst))
(if (number? (car tree))
(map-tree-aux (cdr tree) proc (append-end (proc (car tree)) (map-tree-aux (car tree) proc lst)))
(map-tree-aux (cdr tree) proc lst)))
lst)))
(define (append-end elem lst)
(append lst (list elem)))
While this works with the original example I supplied, a more complex example comes out incorrectly:
(map-tree even? '(1 (2 (3 (4))))) should be '(#f (#t (#f (#t)))), but is currently (#f #t #f #t).
I know it's just a matter is "listing" somewhere, but I'm having an issue finding out how to do it.
My first thought was to apply the list procedure to the lst if the tree is null and (car tree) is not a number, but I get the opposite of what I want (the resultant list is nested in the opposite direction). I'd really appreciate your help.
Thanks!
When iterating over list of lists, the general idea for the cases to check is:
if list is empty (null? lst), do something ...
if the first item in list is atomic (not (pair? (car lst))), do something else ...
if the first item in list is a list itself (pair? (car lst)), else ...
Choosing the right construct is also important, ie. instead of nesting if statements, using cond or match etc. is preferred.
Also try and avoid using non-constant time procedures (such as append) in your recursive steps to improve efficiency.
With these in mind, one approach to create the function in question is by simply using cons to build a new list while preserving the structure of the old, as follows:
(define (my-map pred lst)
(cond
((null? lst) '())
((not (pair? (car lst)))
(cons (pred (car lst))
(my-map pred (cdr lst))))
(else
(cons (my-map pred (car lst))
(my-map pred (cdr lst))))))
You can write the same function using match instead of cond:
(define (my-map pred lst)
(match lst
['() '()]
[(cons (? pair?) b)
(cons (my-map pred (car lst))
(my-map pred (cdr lst)))]
[(cons a b)
(cons (pred (car lst))
(my-map pred (cdr lst)))]))
You can also build a tail-recursive function that does this:
(define (my-map pred lst)
(let loop ((lst lst)
(acc '()))
(cond
((null? lst)
(reverse acc))
((not (pair? (car lst)))
(loop (cdr lst) (cons (pred (car lst)) acc)))
(else
(loop (cdr lst) (cons (loop (car lst) '()) acc))))))
Notice that (reverse acc) is returned in the base case because the list being built in the accumulator acc is in reverse order from the original list lst. To avoid this, we can modify this function to accumulate a continuation instead:
(define (my-map pred lst)
(let loop ((lst lst)
(acc identity))
(cond
((null? lst)
(acc '()))
((not (pair? (car lst)))
(loop (cdr lst) (lambda (r)
(acc (cons (pred (car lst)) r)))))
(else
(loop (cdr lst)
(lambda (r)
(acc (cons (loop (car lst) identity) r))))))))
For all cases, you will have:
(my-map even? '(1 2 3 4 5 7))
=> '(#f #t #f #t #f #f)
(my-map even? '(1 (2 (3 (4 (5 (7)))))))
=> '(#f (#t (#f (#t (#f (#f))))))
I am new to LISP apparently... I am writing a function that takes a list and returns that list with all the duplicates removed, so (myPurge '(p a c e p c))->(a e p c)
This is my (edited)code:
(defun myPurge (L)
(if (eq L nil) ;if empty return nil
nil
(if(eq (car L)(car(cdr L)) ) ;if I find a match call function on
;rest of list
(myPurge (cdr L))
;else return that term and than call on
(progn ;rest of list
(car L)
(myPurge(cdr L)) ))))
*BUTTTTTTTT, when I call this function I get NIL!
*:
Why am i getting NIL instead of it returning car L ?
******Thank you all, this is my finished code that I ended up using( it uses another function 'myMember' I defined earlier.******
(defun myPurge (L)
(if (eq L nil)
nil
(if(myMember(car L)(cdr L))
(myPurge(cdr L))
(cons (car L)(myPurge(cdr L))))))))
****here is myMember*****it returns true if X is a member of L
(defun myMember (X L)
(if(eq L nil)
nil
(if(eq X(car L))
t
(myMember X(cdr L)) )) )
After reformatting your code looks like this:
(defun myPurge (L)
(if (eq L nil)
nil
(if (eq (car L) (car (cdr L)))
(myPurge (cdr L))
(car L)
(myPurge (cdr L)))))
As you can see, the last if is called with 4 arguments. But if only takes 3 arguments (condition, then-part, else-part).
Your code:
(defun myPurge (L)
(if (eq L nil) ;if empty return nil
nil
(if(eq (car L)(car(cdr L)) ) ;if I find a match call function on rest
;of list
(myPurge (cdr L))
;else return that term and than call on
(progn ;rest of list
(car L)
(myPurge(cdr L)) ))))
Correctly indented/formatted/named:
(defun my-purge (list)
(if (null list)
nil
(if (eql (first list) (second list))
(myPurge (rest list))
(progn
(first list)
(my-purge (rest list))))))
What looks strange? See the comment below.
(defun my-purge (list)
(if (null list)
nil
(if (eql (first list) (second list))
(myPurge (rest list))
(progn
(first list) ; <- what does this do?
(my-purge (rest list))))))
Bonus: you can get rid of the nested IFs:
(defun my-purge (list)
(cond ((null list)
nil)
((eql (first list) (second list))
(myPurge (rest list)))
(t
(first list)
(my-purge (rest list)))))
This is my function that's supposed to implement infix evaluation for * and + operations.
(defun calculate(l)
(cond
((eql (cadr l) '+) (+ (car l) (cddr l)))
((eql (cadr l) '*) (- (car l) (cddr l)))
)
)
When I run this with the list '(3 + 4) it gives me an error saying "(4) is not a number". Any ideas what the problem might be?
Symbols can be called as functions. Thus your code is just this:
(defun calculate (l)
(funcall (second l) (first l) (third l)))
or
(defun calculate (l)
(destructuring-bind (arg1 op arg2)
l
(funcall op arg1 arg2)))
Example:
CL-USER 77 > (calculate '(20 + 30))
50
The part with (cddr l) should be (caddr l). You have to access the first element of the list, not the list. The code should be then:
(defun calculate(l)
(cond
((eql (cadr l) '+) (+ (car l) (caddr l)))
((eql (cadr l) '*) (- (car l) (caddr l)))
)
)
I ran over an example of a problem which should determine the list of all non-numeric atoms at any level in a non-linear list.
(Defun Lis(L)
(Cond
((Null L) Nil)
((Not (Numberp (Car L))) (Cons (Car L) (Lis (Cdr L))))
((Atom (Car L)) (Lis (Cdr L)))
(T (Append (Lis (Car L)) (Lis (Cdr L))))
))
I took an example, (Lis '(1 A ((B) 6) (2 (C 3)) D 4)) which should return (A B C D)
Now I don't understand how can the list be created when the 3rd element of the list is evaluated ((B) 6).It will enter on the 2nd branch and do the cons?But that isn't constructing the new list with ((B) 6)?When will it enter on the last branch? I'm a little confused of how this algorithm works,can somebody make it clear for me?
The code works fine if you "invert" the 2 middle tests:
(defun lis(L)
(cond
((null L) nil)
((numberp (car L)) (lis (cdr L)))
((atom (car L)) (cons (car L) (lis (cdr L))))
(t (append (lis (car L)) (lis (cdr L))))))
because (not (numberp (car L))) is also true for lists so in the initial version the code never recurses down into a sublist.
I would write it as:
(defun tree-keep-if (predicate tree)
"Returns the list of all non-numeric atoms at any level in a cons tree."
(mapcan (lambda (item)
(cond ((consp item) (tree-keep-if predicate item))
((funcall predicate item) (list item))
((atom item) nil)))
tree))
Using it:
CL-USER > (tree-keep-if (complement #'numberp) '(1 A ((B) 6) (2 (C 3)) D 4))
(A B C D)
A more sophisticated version might remove the recursion to not be limited by stack size.
I'm writting a program that simplifies polynimials, only addition and multiplication for now.
I've been slamming my head agains the keyboard for hours now and figure it was time to ask for some help.
(defun simplify (lis)
(if (eq (car lis) '+)
(cons '+ (simplify-addition (cdr lis)))
(if (eq (car lis) '*)
(cons '* (simplify-multiplication (cdr lis)))
)
)
)
(defun simplify-addition (lis)
(if (not (null lis))
(if (listp (car lis))
(list (simplify (car lis)) (simplify-addition (cdr lis)))
(if (numberp (car lis))
(if (eq (car lis) 0)
(simplify-addition (cdr lis))
(if (null (cdr lis))
lis
(cons (car lis) (simplify-addition (cdr lis)))
)
)
(if (eq (car lis) '+)
(list (car lis) (simplify-addition (cdr lis)))
(if (eq (car lis) '*)
(list (car lis) (simplify-addition (cdr lis)))
lis
)
)
)
)
)
)
(defun simplify-multiplication (lis)
(if (not (null lis))
(if (listp (car lis))
(if (find 0 (car lis))
0
(list (simplify (car lis)) (simplify-multiplication (cdr lis)))
)
(if (numberp (car lis))
(if (null (cdr lis))
lis
(cons (car lis) (simplify-multiplication (cdr lis)))
)
(if (eq (car lis) '+)
(list (car lis) (simplify-multiplication (cdr lis)))
(if (eq (car lis) '*)
(list (car lis) (simplify-multiplication (cdr lis)))
lis
)
)
)
)
)
)
This is what should happen:
(simplify ‘(+ x ( + 0 3 ) ( * 1 5 ) ( * ( * x y z ) 0 ) )) --> ( + x 3 5 )
(simplify ‘(* (+ 6 0) (* 1 6 2))) --------------------------------> (* 6 (* 6 2))
but instead i either get the same polynomial i sent in, or something completely off
EDIT:
The simplification that i need is to remove 0 from additions, so that:
(+ 3 0) --> 3
(+ 4 0 6) --> (+ 4 6)
and the multiplication with zero are removed
(* 6 0 7) --> 0
First you might want to improve your coding style a bit to make it readable.
don't put parentheses on their own lines. This just wastes space and doesn't help at all.
don't use CAR and CDR in domain specific code. The domain is mathematics. You use expressions (operator arg1 arg2). Instead using CAR and CDR define functions OPERATOR and ARGUMENTS and use them.
use CASE, COND and other multiway conditional expressions, instead of nested IF - where useful.
try to extract the traversal of data structures from domain code. Use higher order functions instead of recursion (MAP, REDUCE, ...).
Example:
Some basic domain functions:
(defun operator (expression)
(first expression))
(defun arguments (expression)
(rest expression))
(defun make-expression (operator arguments)
(if (= (length arguments) 1)
(first arguments)
(cons operator arguments)))
(defun is-zero? (expression)
(and (numberp expression)
(= expression 0)))
Now the simplifications:
(defun simplify (expression)
(if (atom expression)
expression
(case (operator expression)
(+ (make-expression '+ (simplify-addition (arguments expression))))
(* (make-expression '* (simplify-multiplication (arguments expression)))))))
(defun simplify-addition (expressions)
(remove-if #'is-zero?
(mapcar #'simplify
(remove-if #'is-zero? expressions))))
(defun simplify-multiplication (expressions)
(if (member-if #'is-zero? expressions)
(list 0)
(let ((expressions1 (mapcar #'simplify expressions)))
(if (member-if #'is-zero? expressions1)
(list 0)
expressions1))))
See, how much more readable the code is? No more CAR, LIS, CDR. The intention of the recursive invocations is also much clearer to understand.
It still not optimal, but it should get you going.
I've only looked at simplify-multiplication but there are a number of issues here.
On a general note, you want to recursively simplify first, then check for specific constants afterwards. (A post-order traversal, I guess.)
Second, I don't see you checking for 1 anywhere so I don't see how (* 1 5) ==> 5 is supposed to work.
Third, let's step through (simplify '(* (+ 2 0) 3)) for a bit:
(defun simplify-multiplication (lis)
; lis = '((+ 2 0) 3)
(if (not (null lis))
; ==> t
(if (listp (car lis))
; (car lis) = '(+ 2 0), so (listp '(+ 2 0)) ==> t
(if (find 0 (car lis))
; succeeds because '(+ 2 0) contains 0
; this is completely wrong! you're not supposed to check sublists of lis
0
; ... yeah, you just returned 0 just because there was a 0 *somewhere*
(list (simplify (car lis)) (simplify-multiplication (cdr lis)))
)
...
Or (simplify '(* 0 2)):
(defun simplify-multiplication (lis)
; lis = '(0 2)
(if (not (null lis))
; ==> t
(if (listp (car lis))
; (car lis) = 0, so (listp 0) ==> nil
(if (find 0 (car lis))
0
(list (simplify (car lis)) (simplify-multiplication (cdr lis)))
)
(if (numberp (car lis))
; (numberp 0) ==> t
(if (null (cdr lis))
; (cdr lis) = '(2), so (null '(2)) ==> nil
lis
(cons (car lis) (simplify-multiplication (cdr lis)))
; ... wait, what?
; you're just recursively walking through the list without
; checking what numbers you actually got. this won't simplify
; anything.
)
(if (eq (car lis) '+)
; what is this branch for? it can only succeed if you have code of the form
; (* 1 + 2)
; which is a syntax error
(list (car lis) (simplify-multiplication (cdr lis)))
(if (eq (car lis) '*)
; this branch is for code like (* * *). huh???
(list (car lis) (simplify-multiplication (cdr lis)))
lis
)
)
)
)
)
)