Intro
- Here you can find some interesting Lisp Code for Beginners.
- These are the solutions to Mr. Ducournau's Exercise sheet
- Feel free to pose any questions you have on this website: Questions On Lisp (I will really answer ; )
- ;;;;;;;;;;
- ;;; ;;;
- ; 2 ;
- ;;; ;;;
- ;;;;;;;;;;
- ;-----------------------------------------
- ; factorielle - enveloppe
- ; (au lieu de T: (> n 0) aussi possible)
- ;-----------------------------------------
- (defun fact (n)
- (cond ((= n 0) 1)
- (T (* n (fact (- n 1))))))
- ;(print (fact 4))
- ;-----------------------------------------
- ;-----------------------------------------
- ; factorielle - terminale; appel: (factt n 1)
- ;-----------------------------------------
- (defun factt (n m)
- (if (= n 0) m
- (factt (- n 1) (* m n))))
- ;-----------------------------------------
- ;-----------------------------------------
- ; fibo enveloppe, complexite: exp (recursive)
- ;-----------------------------------------
- (defun fibo (n)
- (cond ((or (eq 0 n) (eq 1 n)) 1 )
- (T (+ (fibo(- n 1)) (fibo (- n 2))))))
- ;(print (fibo 5))
- ;-----------------------------------------
- ;-----------------------------------------
- ; fibo - terminale et lineare
- ; complexite: O(n)
- ; fct.: fibo iterativ,calculates all values bottom up and adds them with this value and the value before that
- ;-----------------------------------------
- (defun fibonacci (n)
- (fibo_help 1 0 n)
- )
- (defun fibo_help (x y n)
- (cond ( (= n 0) x )
- ( T (fibo_help (+ x y) x (- n 1)) ))
- )
- ; (trace fibo_help) ;
- ; (print (fibonacci 5))
- ;-----------------------------------------
- ;;;;;;;;;;
- ;;; ;;;
- ; 3 ;
- ;;; ;;;
- ;;;;;;;;;;
- ; regarder feuilles d'exercices
- ;
- ;eq : (eq (()) (()) ) --> NIL
- ;eql: The eql predicate is true if its arguments are eq, or if they are numbers of the same type with the same value, or if they are
- ; character objects that represent the same character. For example:
- ;;;;;;;;;;
- ;;; ;;;
- ; 4 ;
- ;;; ;;;
- ;;;;;;;;;;
- ;-----------------------------------------
- ; member - terminale
- ;-----------------------------------------
- (defun mymember ( x l)
- (cond ((atom l) ()) ; end der liste, oder leere liste
- ((eql (car l) x) l )
- (T (mymember x (cdr l)))))
- ;(print (mymember 3 '(1 2 3 4 5)))
- ;-----------------------------------------
- ;-----------------------------------------
- ; length - enveloppe
- ;-----------------------------------------
- (defun mylength (l)
- (cond ( (NULL (cdr l)) 1)
- (T (+ 1 (mylength (cdr l))))))
- ;(print (mylength '(1 2 '(3 no) 4 5)))
- ;-----------------------------------------
- ;-----------------------------------------
- ; length - terminale (Nr. 7)
- ;-----------------------------------------
- (defun mylength2 (list)
- (labels ((helpF (list length)
- (cond ( (NULL (cdr list)) (+ 1 length))
- (T (helpF (cdr list) (+ length 1))))))
- (helpF list 0)))
- ;(print (mylength2 '(1 2 '(3 no) 4 5)))
- ;-----------------------------------------
- ;-----------------------------------------
- ; last - terminale
- ;-----------------------------------------
- (defun mylast (l)
- (cond ((atom l) ())
- ((eql (cdr l) NIL) (car l)) ;das gleiche: ((atom (cdr l)) l );debuggen:in innere klammer kann (print l) kommen
- (T (mylast (cdr l)))))
- ;(print (mylast '(1 2 '(3 no) 4 '( 2 3))))
- ;-----------------------------------------
- ; makelist(decroissant - absteigend) - enveloppe
- ;-----------------------------------------
- (defun makelist (n)
- (cond ((= n 0) ()) ; mit ((= n 1) 1) zurückgeben ist unschlau, weil keine schöne liste (ende: .1)
- (T (cons n (makelist (- n 1))))))
- ;(print (makelist 5))
- ;-----------------------------------------
- ;-----------------------------------------
- ; makelist (decroissant - absteigend) - terminale
- ; mais avec tric: reverseList a la fin
- ;-----------------------------------------
- (defun makelist2 (n)
- (labels ((help (list n)
- (cond ((= n 0) list)
- (T (help (cons n list) (- n 1)) ))))
- (reverseList (help () n))))
- ;(print (makelist2 5))
- ;-----------------------------------------
- ;-----------------------------------------
- ; makelist revers (croissant - aufsteigend) - terminale
- ;-----------------------------------------
- (defun makelistrev (n l)
- (cond ((= n 0) l)
- (T (makelistrev (- n 1) (cons n l) ) )))
- ;(print (makelistrev 5 () ) )
- ;-----------------------------------------
- ;-----------------------------------------
- ; reverseList : dreht Liste um - terminale
- ;-----------------------------------------
- (defun reverseList (l)
- (labels ((helpFct (l c)
- (cond ((atom l) c)
- (T (helpFct (cdr l) (cons (car l) c)))))); hier hängen wir jeweils das erste element von l vorne dran
- (helpFct l ())))
- ;(print (reverseList '(1 2 (3 no) 4)))
- ;-----------------------------------------
- ;-----------------------------------------
- ; reverseList version2 (avec if) - terminale
- ;-----------------------------------------
- (defun myreverse (l)
- (labels ((aux ( ll r ) ; definition d'une fonction locale, ll est la vielle cellule
- (if (atom ll) r ; r est la copie de la cellul précédent
- (aux (cdr ll) (cons (car ll) r ) ))))
- (aux l ()) ))
- ;(trace myreverse) ; arbeitet mit labels, daher nicht sinnvoll hier
- ;(myreverse '(1 2 3 4 5))
- ;(untrace myreserse)
- ;-----------------------------------------
- ;-----------------------------------------
- ; copylist
- ;-----------------------------------------
- (defun copylist (l)
- (reverseList (reverseList l)))
- ;(print (copylist '(1 2 3 4)))
- ;-----------------------------------------
- ;-----------------------------------------
- ; copylist version2 - enveloppe
- ;-----------------------------------------
- (defun copylist2 (l1)
- (cond ((atom (cdr l1)) l1)
- (T (cons (car l1) (copylist2 (cdr l1)) ))))
- ; (print (copylist2 '(1 2 3 4)))
- ;-----------------------------------------
- ;-----------------------------------------
- ; copylist version3 - terminale
- ; mais avec tric de reverseList
- ;-----------------------------------------
- (defun copylist3 (l1 copy)
- (cond ((atom l1) (reverseList copy))
- (T (copylist3 (cdr l1) (cons (car l1) copy) ) )))
- ;(print (copylist3 '(1 2 3 4) ()))
- ;-----------------------------------------
- ;-----------------------------------------
- ; remove (pareil comme delete)
- ;-----------------------------------------
- (defun myremove (x l)
- (cond ((atom l) l)
- ((eql (car l) x) (myremove x (cdr l)) )
- (T (cons (car l) (myremove x (cdr l)) )))))
- ;(print (myremove 3 '( 1 2 3 4 5 6)))
- ;-----------------------------------------
- ;-----------------------------------------
- ; remove avec les mêmes cellules --> setf - marche
- ;-----------------------------------------
- ; wir setzen cdr ll auf delete von cdr ll und geben danach ll normal, dh falls sich nichts ändert, bleibt ll gleich
- (defun delete2 (x ll) ; copie de ll sans les x
- (cond ((atom ll) ll)
- ((eql (car ll) x) (delete2 x (cdr ll)))
- (T (progn (setf (cdr ll) (delete2 x (cdr ll))) ll))))
- ;(print (delete2 3 '(1 2 3 4 5 6)))
- ;-----------------------------------------
- (setq d '(1 2 3 4 5 6))
- (print (delete2 1 d)) ;=> (2 3 4 5 6)
- (print d) ; => (1 2 3 4 5 6) ;wieder wie vorher, auch bei (setq d ...), weil d immer noch auf 1 zeigt, ABER:
- (print (delete2 2 d)) ;=> (1 3 4 5 6)
- (print d) ;=> da is die 2 auch weg...
- ;-----------------------------------------
- ; append, verbindet nur 2 listen, soll aber ineffizient programmiert sein ^^
- ;-----------------------------------------;
- (defun myappend (l1 l2)
- (cond ((atom l1) l2)
- (T (cons (car l1) (myappend (cdr l1) l2) ))))
- ;(print (myappend '(1 2 3) '(4 5 6) ))
- (print (myappend '() '(4 5 6) ))
- ;-----------------------------------------
- ;-----------------------------------------
- ; append fuer mehrere listen, # kann auch weggelassen werden...
- ;-----------------------------------------
- (defun myappend2 (l &rest ll) ; l = 1ère liste, ll= la liste des autres listes!
- (if (null ll) l ; dann haben wir alle angefügt und geben die liste aus
- (if (atom l) (apply #'myappend2 ll) ; wenn wir alle vorne abge-car-t haben, starten wir mit der nächsten liste
- (cons (car l) (apply #'myappend2 (cdr l) ll))))) ; und am ende bauen wir sie alle zusammen ==> Trés inefficace!!
- ; apply is like funcall, except that its final argument should be a list; the elements of that list are treated as if they were
- ; additional arguments to a funcall --> due to apply,, the rest lists are treated as seperate elements, not as lists (which would
- ; later be treated as just one element of the final list)
- ;(print (myappend2 '(1 2 3) '(4 5 6) '(7 8)))
- ;-----------------------------------------
- ;;;;;;;;;;;;;;################################################################################## version avec les même cellule?
- ; question: comment avec setf?
- ; siehe lösung vorher mit setf in copytree !!
- (defun appendSf (l &rest ll)
- (if
- ))
- ;-----------------------------------------;
- ; adjoin
- ; fügt ein element hinzu, falls es nicht schon vorhanden ist, eine mengenoperation
- ;-----------------------------------------
- (defun madjoin (item list)
- (if (member item list) list
- (cons item list))); else-zweig
- ;(print (madjoin '4 '(1 2 3)))
- ;(print (madjoin '4 '(1 2 3 4)))
- ;-----------------------------------------
- ;;;;;;;;;;;-----------------------------------------
- ;;; ;;;
- ; 5 ;
- ;;; ;;;
- ;;;;;;;;;;;-----------------------------------------
- ;-----------------------------------------
- ; treeSize: berechnet die menge aller zellen (also innerer und aeusserer blätter - enveloppe
- ; beachte, das weitere verzweigungen immer auch nur ein car sind und das jeweilige cdr eine () ist!
- ; (siehe extra zettel)
- ;-----------------------------------------
- ; ############################################################depends si "()" sont feuilles ou pas aussi numberOfLeaves
- (defun treeSize (tree)
- (if (atom tree) 1
- (+ (treeSize (car tree)) (treeSize (cdr tree)))))
- ;(trace treeSize)
- ;(print (treeSize '( ((1 2) b ) (3 (5 (6 7))) )))
- ;(print (treeSize '(a (b c))))
- ;-----------------------------------------
- ;-----------------------------------------
- ; does not work, see version with if - enveloppe
- ; numberOfLeaves that are not empty --> leaves with content
- ;-----------------------------------------
- (defun numberOfLeaves (tree)
- (cond ((and (atom tree) (eq NIL tree)) 0)
- ((and (atom tree) (not (eq NIL tree))) 1)
- (T (+ (numberOfLeaves (car tree)) (numberOfLeaves (cdr tree))) )))
- ;trace numberOfLeaves)
- ;print (numberOfLeaves '(a (b c))))
- ; ################################################################## pourquoi il return 0 toujours?
- ; ok
- ;------------------------------------------
- ; number of leaves not nil - works - enveloppe
- ;------------------------------------------
- (defun numberOfLeaves2 (tree)
- (if (and (atom tree) (eq NIL tree)) 0
- (if (and (atom tree) (not (eq NIL tree))) 1
- (+ (numberOfLeaves2 (car tree)) (numberOfLeaves2 (cdr tree))) )))
- ;(print (numberOfLeaves2 '(a (b c))))
- ;------------------------------------------
- ; number of leaves not nil - enveloppe
- ;------------------------------------------
- (defun numberOfAllLeaves (tree)
- (if (atom tree) 1
- (+ (numberOfAllLeaves (car tree)) (numberOfAllLeaves (cdr tree))) ))
- ;(print (numberOfAllLeaves '(a (b c))))
- ;------------------------------------------
- ;-------------------------------------------
- ; copytree - works - enveloppe
- ;------------------------------------------
- (defun copytree (tree)
- (if (atom tree) tree
- (cons (copytree (car tree)) (copytree (cdr tree)))))
- ;------------------------------------------
- ;------------------------------------------
- ; substitute: replaces all x for y in tree - works - enveloppe
- ;------------------------------------------
- (defun mySubst (x y tree)
- (if (eql tree x) y
- (if (atom tree) tree
- (cons (mySubst x y (first tree)) (mySubst x y (rest tree))))))
- ;(print (mySubst 'a '1 '((a 2) ((3 a) (4 5)))))
- ;------------------------------------------
- ;------------------------------------------
- ; treeLeaves - returns list with leaves with NIL - works
- ;------------------------------------------
- ; lazy version: (defun treeLeavesLazy (tree) (collect-append tree))
- ; il ne connait pas cette fonction, mais les 2 sont gnu cl...
- ;------------------------------------------
- (defun treeLeaves (tree list)
- (if (atom tree) (cons tree list)
- (append (treeLeaves (first tree) list ) (treeLeaves (rest tree) list) )))
- ;(print (treeLeaves '((a 2) ((3 a) ((3 4) 5))) () ))
- ;------------------------------------------
- ;;;;;;;;;;;-----------------------------------------
- ;;; ;;;
- ; 6 ;
- ;;; ;;;
- ;;;;;;;;;;;-----------------------------------------
- ;(eq x y) is true if and only if x and y are the same identical object.
- ; The eql predicate is true if its arguments are eq, or if they are numbers of the same type with the same value,
- ; or if they are character objects that represent the same character.
- ; The equal predicate is true if its arguments are structurally similar (isomorphic) objects.
- ; A rough rule of thumb is that two objects are equal if and only if their printed representations are the same.
- ;-----------------------------------------
- ; function equal:
- ;-----------------------------------------
- (defun myequal (list1 list2)
- (if (and (atom list1) (atom list2) (eql list1 list2) ) T
- (if (and (not (atom list1)) (atom list2)) NIL
- (if (and (not (atom list1)) (atom list2)) NIL
- (if (and (not (atom list1)) (not(atom list2)))
- (and (myequal (car list1) (car list2)) (myequal (cdr list1) (cdr list2))))))))
- ;(trace myequal)
- ;(print (myequal '(((1 3) 4 ) (4 5)) '(((1 g) 4 ) (f g)) ))
- ;(print (myequal '(((1 3) 4 ) (4 5)) '(((1 3) 4 ) (4 5)) ))
- ;-----------------------------------------
- ;;;;;;;;;;;-----------------------------------------
- ;;; ;;;
- ; 7 ;
- ;;; ;;;
- ;;;;;;;;;;;-----------------------------------------
- ; solutions pour fonctions terminales sur les arbre sont just a cote des fonctions enveloppe
- ;-----------------------------------------
- ; treeSize: - partiel terminale!
- ;-----------------------------------------
- (defun treeSize2 (tree size)
- (if (atom tree) size
- (treeSize2 (car tree) (treeSize2 (cdr tree) (+ size 1)))))
- ;(trace treeSize2)
- ;(print (treeSize2 '(a (b c)) 0) )
- ; ----------------------------------#################################### return only 4, error ?
- ;-----------------------------------------
- ;-------------------------------------------
- ; copytree - partiel terminale! ==> ## n'exist pas, impossible ##
- ;------------------------------------------
- ;(defun copytree2 (tree rTree)
- ; (if (atom tree) tree
- ; (copytree2 (car tree) (cons (copytree2 (cdr tree) (cons (car tree) rTree))))))
- ;------------------------------------------
- ;(trace copytree2)
- ;(print (copytree2 '(a (b c)) 0) )
- ;------------------------------------------
- ; treeLeaves - returns list with leaves with NIL
- ; - partiel terminale!
- ;------------------------------------------
- ; lazy version: (defun treeLeavesLazy (tree) (collect-append tree)) ; il ne connait pas cette fonction, mais les 2 sont gnu cl...
- ;------------------------------------------
- (defun treeLeaves2 (tree list)
- (if (atom tree) (cons tree list)
- (append (treeLeaves2 (first tree) list ) (treeLeaves2 (rest tree) list) )))
- ;(print (treeLeaves2 '((a 2) ((3 a) ((3 4) 5))) () ))
- ;------------------------------------------
Leave Comments & Responses
Feel free to leave a comment here. The latest comment is on top.