;Question 6
(defun expo (base exp)
( if (eq exp 0)
1
(* base (expo base (- exp 1)))
)
)
(defun fact (n)
(if (= n 0)
1
(* n (fact (- n 1)))
)
)
(defun sin-cos-comp (x n)
(if (or (not(typep n 'integer)) (not (typep x 'integer)))
(return-from sin-cos-comp "Invalid input")
)
(if (oddp n)
(if (or(<= x -10)(>= x 10))
(print "The value entered for x is not valid")
)
)
(setf counter 0)
(if (evenp n)
(setf result 1)
(setf result x)
)
(if (evenp n)
(loop for i from 1 to (/ n 2)
do
(if (evenp counter)
(setf result (- result (/ (expo x (* i 2)) (fact (* i 2))) ))
(setf result (+ result (/ (expo x (* i 2)) (fact (* i 2))) ))
)
(setf counter (+ counter 1))
)
(loop for i from 1 to (/ (- n 1) 2)
do
(if (evenp counter)
(setf result (- result (/ (expo x (+ (* i 2) 1)) (fact (+(* i 2) 1)))))
(setf result (+ result (/ (expo x (+ (* i 2) 1)) (fact (+(* i 2) 1)))))
)
(setf counter (+ counter 1))
)
)
(block nil (return result))
)
(print (sin-cos-comp 8 2))
;; A simple LISP interpreter written by Dr Klefstad for ICS 141 at UCI
;; Of course, I deleted lots of it to let you learn more about evaluation.
;; my-assoc returns the association (binding) of a variable in the association
;; list. An alist is a list of this form:
;; ((var1 . val1) (var2 . val2) ... (varN . valN))
;; where each vari is a symbol representing a variable (or parameter) name
;; and each vali is the value of the variable.
;; assoc returns the association of a given symbol, e.g,
;; (assoc 'myvar '((a . 10)(b a b c)(myvar d e f)))
;; returns (myvar d e f) and you take the cdr of that to get myvar's value
;; (d e f)
;; We will use alists for the stack of variables and their values. Assoc
;; always finds the first association of a variable, and this is how we
;; implement dynamic scoping. New defintions of a variable will hide older
;; definitions, but the older definitions will come back into scope when
;; recursive evaluation unwinds.
;; setq and defun will push a new association on the global-alist.
;; whenever we apply a function, we will bind the formals to the evaluated
;; actuals pushing these new bindings onto the local alist and then
;; evaluate the body of the function in that new scoping context.
;; You need to write this one.
(defun my-assoc (v alist)
(cond
((null alist) nil)
((eq v (car (car alist))) (car alist))
(t (my-assoc v (cdr alist)))
)
)
;; This one is done
(defun my-eval (e alist)
; (write " in my-eval ")
(cond ((atom e) (my-eval-atom e alist))
(t (my-apply (car e) (cdr e) alist))
)
)
(defun my-eval-atom (e alist)
(cond
((null e) nil)
((symbolp e) (cdr (my-assoc e alist)))
(t e)
)
)
;; This one is done, but you must write the functions it calls
(defun my-apply (fn args alist)
; (write "in my-apply")
(cond ((atom fn) (my-apply-atom fn args alist))
( t (my-apply-lambda fn args alist)))
)
(defun my-eval-list (l alist)
(cond
((null (cdr l)) (my-eval (car l) alist))
(t (my-eval (car l) alist) (my-eval-list (cdr l) alist))
)
)
;; You need to write this one.
(defun my-apply-lambda (fn args alist)
; (write "in lambda!")
(write fn)
(write args)
(write alist)
(write-line "")
(my-eval-list fn (my-bind-formals fn alist) args alist)
;; bind the formals to the evaluated actuals then evaluate the body in that
;; new scoping context (i.e., that becomes the new alist for recursive
;; evaluation of the function body. Return the value of the last
;; expression in the body (using eval-list).
)
;; You need to write this one.
(defun my-bind-formals (formals actuals alist)
(cond
((null (car formals)) alist)
((null (car actuals)) alist)
(t (my-bind-formals (cdr formals) (cdr actuals) (cons (cons (car formals) (my-eval (car actuals) alist)) alist)))
)
;; This takes a list of formals and unevaluated actuals. It should evaluate
;; each actual and bind it to its corresponding formal placing them all on
;; the front of the alist. It should return the alist with the new bindings
;; on the front. This will be used to evaluate calls to functions defined
;; via defun.
;; e.g., (my-bind-formals '(a) '((add 1 b)) '((b . 10)))
;; will return ((a . 11) (b . 10))
;; Note there will be one actual parameter for each formal parameter.
)
(defun my-apply-atom (fn args alist)
; (write "in my-apply-atom")
(write args)
(cond
((eq fn 'eq)
(eq (my-eval (car args) alist) (my-eval (cadr args) alist)))
;; I wrote the first one, eq, for you, you write the rest
((eq fn 'car)
(car args)
)
((eq fn 'cdr)
(cdr args)
)
((eq fn 'cons)
(cons (car args) (cdr args))
)
((eq fn 'quote)
args
)
((eq fn 'setq) (my-eval-setq (car args) (cadr args)))
;; these are (nearly) done, but you must write the sub-functions
((eq fn 'cond) (my-eval-cond args alist))
((eq fn 'defun) (my-eval-defun args alist))
((eq fn 'eval) (my-eval (my-eval (car args) alist) alist))
(T (my-apply (my-assoc fn alist) args alist))
)
)
(defun my-eval-setq (var val)
(setq global-alist (cons (cons var val) global-alist))
)
;; You need to write this one. You should know how cond works at this point.
(defun my-eval-cond (clauses alist)
(write "in cond")
)
;; You need to write this one.
(defun my-eval-defun (body alist)
(write "in defun")
(my-eval-setq (car body) (cdr body))
;; just push the function body onto the global alist. It is already an
;; association, e.g., (equal (L1 L2) (cond (...))) and (assoc 'equal in
;; the global alist will return this. You can then take the cdr and you
;; have a list containing the formal parameters and the expressions in
;; the function body.
)
;; This one is done, it just initializes the global alist where global
;; settings, like those defined via setq and defun, go.
(setq global-alist nil)
;; to push a new value, (setq global-alist (cons (cons 'newvar 'newval) global-alist))
;; This one is done, it will become the new top-level for LISP. After you
;; load this file, call (my-top) and then you can type in expressions and
;; define and call functions to test your my-eval.
(defun my-top ()
(prog ()
top (print (my-eval (read) global-alist))
(terpri) ;; prints a newline
(go top) ;; loops forever
)
)
; (setq x 4)
; (write x)
(my-top)
; (defun X (A) A)
(defun X (A) A)
( X ' B )
; (write (MY-APPLY-LAMBDA 'X '((QUOTE B)) '((A . B) (X (A) A)) ))
; (write (MY-EVAL-LIST '(A) '((A . B) (X (A) A))))
; (write (my-eval '(eq 10 b) '((b . 10))))
; (write (my-bind-formals '(a) '((eq 10 b)) '((b . 10))))
; (write (my-eval-list '(10 x 8) global-alist))
; (write (my-eval-setq 'A 10))
; (write (my-apply-atom 'setq '(A 10) '(a )))
; (write (my-apply-atom 'quote '(a b c) '(a)))
(defun distance(p1 p2)
(setf x1 (car(p1)))
(setf x2 (car(p2)))
(setf y1 (cdr(p1)))
(setf y2 (cdr(p2)))
(sqrt (+ (* (- x1 x2) (- x1 x2)) (* (- y1 y2) (- y1 y2)) ) )
)
(funcall 'distance (3 3) (2 2)))
(defun triprint (n)
(if (integerp n)
(loop for a from 1 to n
do (
loop for b from 1 to a
do (write b)
(if (= b a)
(write-line ""))
)
)
( else (write-line "Incorrect input; please enter an integer value"))
)
)
(funcall 'triprint '3)
(defun triangle (a)
(cond
((stringp a)
(format t "strings are not valid input, please enter an integer")
)
((not (numberp a))
(format t "please enter an integer greater or equal to 1")
)
((and (> a 0) (integerp a))
(dotimes (row a)
(print 1)
(if (> a 1)
(dotimes (column row)
(write (+ column 2))
(format t " ")
)
)
)
)
((and (< a 1) (integerp a))
(format t "integers less than 1 are not valid input, please enter an integer greater or equal to 1")
)
((numberp a)
(format t "decimal numbers are not valid input, please enter an integer")
)
)
)
(triangle 'a)
(defun sin-cos-comp (x n)
(if (and (integerp x) (integerp n))
(if (oddp n)
(if (and (< -10 x) (< x 10))
(print (series x n 1 2 0))
(print "X has to be between -10 and 10")
)
(print (series x n 0 2 0))
)
(print "X and N must be integers")
)
)
(defun series (x n counter alternation total)
(setq total
(/
(* (exponent -1 alternation 0) (exponent x counter 0))
(factorial counter 1)
)
)
(if (> n (+ 1 counter))
(+ total (series x n (+ counter 2) (+ alternation 1) total))
total
)
)
(defun factorial (x counter)
(if (> x counter)
(* counter (factorial x (+ counter 1)))
counter
)
)
(defun exponent (x n counter)
(if (= n 0)
1
(if (< (+ counter 1) n)
(* x (exponent x n (+ counter 1)))
x
)
)
)
(write "(sin-cos-comp 2 7):")
(sin-cos-comp 2 7)
(write-line "")
(print "(sin-cos-comp 2 6):")
(sin-cos-comp 2 6)
(write-line "")
(print "INVALID CASES:")
(sin-cos-comp 10 7)
(sin-cos-comp 1.5 7)
(sin-cos-comp 2 7.5)
(defun modulo()
(setq a (read))
(setq b (read))
(setq c (+ (* a a) (* b b)))
(setq m (sqrt c))
(terpri)
(format t "O modulo do vetor e ~f" m)
)
(modulo)
;; You need to write this one.
(defun my-assoc (v alist)
(cond ((eq v (car (car alist))) (car alist) )
((null (cdr alist)) nil)
(t(my-assoc v (cdr alist))))
)
;; This one is done
(defun my-eval (e alist)
(cond ((atom e) (my-eval-atom e alist))
(t (my-apply (car e) (cdr e) alist))
) )
;; You need to write this one.
(defun my-eval-atom (e alist)
;; how do you evaluate an atom???
;; Remember there are special cases: T, NIL, ASYMBOL, 10, "Hello"
(cond ((null e) nil ) ; nil
((null (my-assoc e alist)) e)
(t(cdr (my-assoc e alist))))
)
;; This one is done, but you must write the functions it calls
(defun my-apply (fn args alist)
(cond ((atom fn) (my-apply-atom fn args alist))
( t (my-apply-lambda fn args alist)))
)
;; You need to write this one.
;; Utility function for eval-cond and apply-lambda. Evaluates each expression
;; in l and returns the value of the last expression
(defun my-eval-list (l alist)
(cond ((null (my-eval (car l) alist)) nil )
(t(cond ((null (cdr l)) (my-eval (car l) alist) )
(t(my-eval-list (cdr l) alist)))))
)
; test MY-EVAL-LIST
;(write (my-eval-list '(a b c) '((a . 10) (b . 11 ) (d . 12))))
;; You need to write this one.
(defun my-apply-lambda (fn args alist)
;; bind the formals to the evaluated actuals then evaluate the body in that
;; new scoping context (i.e., that becomes the new alist for recursive
;; evaluation of the function body. Return the value of the last
;; expression in the body (using eval-list).
)
;; You need to write this one.
(defun my-bind-formals (formals actuals alist)
;; This takes a list of formals and unevaluated actuals. It should evaluate
;; each actual and bind it to its corresponding formal placing them all on
;; the front of the alist. It should return the alist with the new bindings
;; on the front. This will be used to evaluate calls to functions defined
;; via defun.
;; e.g., (my-bind-formals '(a) '((add 1 b)) '((b . 10)))
;; will return ((a . 11) (b . 10))
;; Note there will be one actual parameter for each formal parameter.
)
;; A simple LISP interpreter written by Dr Klefstad for ICS 141 at UCI
;; Of course, I deleted lots of it to let you learn more about evaluation.
;; my-assoc returns the association (binding) of a variable in the association
;; list. An alist is a list of this form:
;; ((var1 . val1) (var2 . val2) ... (varN . valN))
;; where each vari is a symbol representing a variable (or parameter) name
;; and each vali is the value of the variable.
;; assoc returns the association of a given symbol, e.g,
;; (assoc 'myvar '((a . 10)(b a b c)(myvar d e f)))
;; returns (myvar d e f) and you take the cdr of that to get myvar's value
;; (d e f)
;; We will use alists for the stack of variables and their values. Assoc
;; always finds the first association of a variable, and this is how we
;; implement dynamic scoping. New defintions of a variable will hide older
;; definitions, but the older definitions will come back into scope when
;; recursive evaluation unwinds.
;; setq and defun will push a new association on the global-alist.
;; whenever we apply a function, we will bind the formals to the evaluated
;; actuals pushing these new bindings onto the local alist and then
;; evaluate the body of the function in that new scoping context.
;; You need to write this one.
(defun my-assoc (v alist)
(cond
((null v) nil)
( (eq v (car (car alist))) (car alist))
(t (my-assoc v (cdr alist)) )
)
)
;; This one is done
(defun my-eval (e alist)
(cond ((atom e) (my-eval-atom e alist))
(t (my-apply (car e) (cdr e) alist))
)
)
(trace my-eval)
;; You need to write this one.
(defun my-eval-atom (e alist)
;; how do you evaluate an atom???
;; Remember there are special cases: T, NIL, ASYMBOL, 10, "Hello"
(cond
((eq t e) t)
((null e) nil)
((symbolp e) (cdr (my-assoc e alist)))
(t e)
)
)
(trace my-eval-atom)
;; This one is done, but you must write the functions it calls
(defun my-apply (fn args alist)
(cond ((atom fn) (my-apply-atom fn args alist))
( t (my-apply-lambda fn args alist)))
)
(trace my-apply)
;; You need to write this one.
;; Utility function for eval-cond and apply-lambda. Evaluates each expression
;; in l and returns the value of the last expression
(defun my-eval-list (l alist)
(cond
((null (cdr l)) (my-eval (car l) alist))
(t (my-eval (car l) alist) (my-eval-list (cdr l) alist) )
)
)
(trace my-eval-list)
;; You need to write this one.
(defun my-apply-lambda (fn args alist)
;; bind the formals to the evaluated actuals then evaluate the body in that
;; new scoping context (i.e., that becomes the new alist for recursive
;; evaluation of the function body. Return the value of the last
;; expression in the body (using eval-list).
(my-eval-list (cdr (cdr fn)) (my-bind-formals (cadr fn) args alist))
)
(trace my-apply-lambda)
;; You need to write this one.
(defun my-bind-formals (formals actuals alist)
;; This takes a list of formals and unevaluated actuals. It should evaluate
;; each actual and bind it to its corresponding formal placing them all on
;; the front of the alist. It should return the alist with the new bindings
;; on the front. This will be used to evaluate calls to functions defined
;; via defun.
;; e.g., (my-bind-formals '(a) '((add 1 b)) '((b . 10)))
;; will return ((a . 11) (b . 10))
;; Note there will be one actual parameter for each formal parameter.
(cond
((null formals) alist)
(t (cons (cons (car formals) (my-eval (car actuals) alist))
(my-bind-formals (cdr formals) (cdr actuals) alist)))
)
)
(trace my-bind-formals)
;; You need to write this one. Handle the primitives as special cases, then
;; handle user defined functions (defined via defun) in the default case.
;; These are the only functions we handle: eq, car, cdr, cons, quote, cond,
;; defun, eval, setq, and user defined functions (defined via defun) that
;; we have evaluated. You can add more built-ins (like plus, times, atom,
;; listp) as you like for testing.
(defun my-apply-atom (fn args alist)
(cond ((eq fn 'eq)
(eq (my-eval (car args) alist) (my-eval (cadr args) alist)))
;; I wrote the first one, eq, for you, you write the rest
((eq fn 'car)
(car (my-eval (car args) alist)))
((eq fn 'cdr)
(cdr (my-eval (car args) alist)))
((eq fn 'cons)
(cons (my-eval (car args) alist) (my-eval (cadr args) alist)))
((eq fn 'quote)
(car args))
((eq fn 'null)
(eq (my-eval (car args) alist) nil ))
((eq fn 'setq) (my-eval-setq (car args) (my-eval(cadr args) alist)))
;; these are (nearly) done, but you must write the sub-functions
((eq fn 'cond) (my-eval-cond args alist))
((eq fn 'defun) (my-eval-defun args alist))
((eq fn 'eval) (my-eval (my-eval (car args) alist) alist))
(T (my-apply (my-assoc fn alist);; get the lambda from the alist,
args alist))
)
)
(trace my-apply-atom)
;; You need to write this one.
(defun my-eval-setq (var val)
;; just push a new association of the var and its evaluated val onto the
;; global alist
(setq global-alist (cons (cons var val) global-alist))
)
(trace my-eval-setq)
;; You need to write this one. You should know how cond works at this point.
(defun my-eval-cond (clauses alist)
(cond
((null clauses) nil)
((eq t (my-eval (car (car clauses)) alist)) (my-eval-list (cdr (car clauses)) alist))
(t (my-eval-cond (cdr clauses) alist))
)
)
(trace my-eval-cond)
;; You need to write this one.
(defun my-eval-defun (body alist)
;; just push the function body onto the global alist. It is already an
;; association, e.g., (equal (L1 L2) (cond (...))) and (assoc 'equal in
;; the global alist will return this. You can then take the cdr and you
;; have a list containing the formal parameters and the expressions in
;; the function body.
(my-eval-setq (car body) (cdr body))
)
(trace my-eval-defun)
;; This one is done, it just initializes the global alist where global
;; settings, like those defined via setq and defun, go.
(setq global-alist nil)
(print (my-bind-formals '(a d) '((quote b) (quote c) )'((x (a) a))))
(print (my-eval '(x (quote b)) '((x (a) (cond ((eq a 'b ) 1 (cons 3 a)) (t 2))))))
(print (my-eval '(defun x (a) a) nil))
(print (my-eval ' (defun rev (L A) (cond ((null L) A) (t (rev (cdr L) (cons (car L) A))))) global-alist))
(print (my-eval '(setq a '(a b c)) global-alist))
;(print (my-eval '(rev '(A B C D E) nil) global-alist))
(print (my-eval '(rev a nil) global-alist))
;; to push a new value, (setq global-alist (cons (cons 'newvar 'newval) global-alist))
;; This one is done, it will become the new top-level for LISP. After you
;; load this file, call (my-top) and then you can type in expressions and
;; define and call functions to test your my-eval.
(defun my-top ()
(prog ()
top (print (my-eval (read) global-alist))
(terpri) ;; prints a newline
(go top) ;; loops forever
)
)
(defun is-bst (usertree)
(if (null (bst-finder usertree))
(write-line "The Tree is a Binary Search Tree.")
(write-line "The Tree is NOT a Binary Search Tree.")
)
)
(defun bst-finder (usertree)
(if (not (null (car (car (cdr usertree)))))
(cond
((null usertree) t) ;is tree emtpy ?
((< (car usertree) (car (car (cdr usertree)))) t) ;is left > top ?
((bst-finder (car (cdr usertree))) t) ;try again left
)
nil ;if we reach the end
;of the branch, return null
)
(if (not (null (car (car (cdr (cdr usertree))))))
(cond
((null usertree) t) ;is tree emtpy ?
((> (car usertree) (car (car (cdr (cdr usertree))))) t) ;is right < top ?
((bst-finder (car (cdr (cdr usertree)))) t) ;try again right
)
nil ;if we reach the end
;of the branch, return null
)
)
;==============================================================================================
(write (list 8 '(3 (1 () ()) (6 (4 () ())( 7 () ()))) '(10 (()) (14 (13) ()))))
(write-line "")
(is-bst (list 8 '(3 (1 () ()) (6 (4 () ())( 7 () ()))) '(10 (()) (14 (13) ()))))
(print (list 8 '(3 (5 () ()) (6 (4 () ())( 7 () ()))) '(10 (()) (2 (13) ()))))
(write-line "")
(is-bst (list 8 '(3 (5 () ()) (6 (4 () ())( 7 () ()))) '(10 (()) (2 (13) ()))))
We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy. Accept Learn more
