2010-lisp/eksempelkode.lisp

;;; Eksempelkode fra PVVs Lisp-kurs 11.03.2010.

;;; Skrevet av eirikald og oysteini.

;;; Se http://wiki.pvv.ntnu.no/pvv/Kurs/Lisp_1

;;; Denne filen inneholder alle funksjonsdefinisjonene fra kurset.  Se
;;; presentasjonen for beskrivelser og eksempler på anvendelse av
;;; funksjonene.

;;; I SLIME kan du laste inn hele filen med C-c C-l eller
;;; enkeltdefinisjoner med C-M-x.  En advarsel om at variabelen _ er
;;; ubrukt i funksjonen LEN* er forventet.  For øvrig bør filen kunne
;;; lastes inn uten problemer.




;;; Del 1.

(defun square (x) (* x x))

(defun hypothenuse (side1 side2)
  (sqrt (+ (square side1) (square side2))))

(defun describe-number (n)
  (if (evenp n)
      "It is even!"
      "It is odd!"))

(defun ! (n)
  (if (= n 0)
      1
      (* n
         (! (- n 1)))))

(defun fib (n)
  (if (< n 2)
      1
      (+ (fib (- n 1))
         (fib (- n 2)))))

(defun elem (n list)
  (if (= n 0)               ; hvis N er 0
      (first list)          ; vil vi ha første element,
      (elem (- n 1)         ; ellers vil vi ha (N-1)-te
            (rest list))))  ; fra resten av listen

(defun len (list)
  (if (null list)         ; Hvis listen er tom
      0                   ; er lengden 0,
      (+ 1                ; ellers er den 1 pluss
         (len             ; lengden til
          (rest list))))) ; resten av listen.

(defun sum (list)
  (if (null list)          ; Hvis listen er tom
      0                    ; er dens sum 0,
      (+ (first list)      ; ellers første tall pluss
         (sum              ; summen av
          (rest list)))))  ; resten av listen.

(defun iota (a b)
  (if (> a b)
      nil
      (cons a
            (iota (+ a 1) b))))

(defun cat (list1 list2) ; meow
  (if (null list1)
      list2
      (cons (first list1)
            (cat (rest list1) list2))))

(defun insert (elem i list)
  (if (= i 0)
      (cons elem list)
      (cons (first list)
            (insert elem
                    (- i 1)
                    (rest list)))))

(defun collatz (n)
  (if (evenp n)
      (/ n 2)
      (1+ (* n 3))))

(defun collatz-length (n)
  (if (= n 1)
      0
      (+ 1 (collatz-length (collatz n)))))




;;; Del 2.

(defun compose (f g)
  (lambda (x)
    (funcall f (funcall g x))))

(defun apply-over (fun list)
  (if (null list)
      nil
      (cons (funcall fun (first list))
            (apply-over fun (rest list)))))

(defun foldr (fun initial list)
  (if (null list)
      initial
      (funcall fun
               (first list)
               (foldr fun initial (rest list)))))

(defun !* (n)
  (foldr #'* 1 (iota 1 n)))

(defun len* (list)
  (foldr (lambda (_ l) (1+ l))
         0
         list))

(defun drop (n list)
  (if (= n 0)
      list
      (drop (- n 1) (rest list))))

(defun fact-tailrec (n acc)
  (if (= n 0)
      acc
      (fact-tailrec (- n 1) (* n acc))))

(defun fact (n)
  (fact-tailrec n 1))

(defun fib-rec (n i fibI fibI-1)
  (if (= i n)
      fibI
      (fib-rec n (1+ i)
               (+ fibI fibI-1) fibI)))

(defun fib* (n)
  (if (< n 2)
      1
      (fib-rec n 1 1 1)))

(defun fn-key (&key name (age 20))
  (list name age))

(defun fn-optional (&optional name (age 20))
  (list name age))

(defun fn-rest (mom &rest children)
  (list mom children))

(defun flip-append (list tail)
  (if (null list)
      tail
      (flip-append (rest list)
                   (cons (first list) tail))))

(defun flip (list)
  (flip-append list nil))

(defun repeat (fun initial end &key (test #'eql))
  (if (funcall test initial end)
      (list end)
      (cons initial
            (repeat fun (funcall fun initial) end
                    :test test))))

(defun collatz-list (n)
  (repeat #'collatz n 1))




;;; Del 3.

(defun braid (list1 list2) ; merge
  (if (null list1)
      list2
      (if (null list2)
          list1
          (if (<= (first list1) (first list2))
              (cons (first list1)
                    (braid (rest list1) list2))
              (cons (first list2)
                    (braid list1 (rest list2)))))))

(defun braid* (list1 list2)
  (cond
    ((null list1) list2)
    ((null list2) list1)
    ((<= (first list1) (first list2))
     (cons (first list1)
           (braid (rest list1) list2)))
    (t
     (cons (first list2)
           (braid list1 (rest list2))))))

(defun assoc-value (key alist &key (default nil))
  (let ((pair (assoc key alist)))
    (if pair
        (cdr pair)
        default)))

(defun prefix-to-infix (expr)
  (let ((func (first expr))
        (arg1 (second expr))
        (arg2 (third expr)))
    (list arg1 func arg2)))