roma in italia est

;;Lecture 8

;;1-1
(defun approx-= (a b epsilon)
  (<= (abs (- a b)) epsilon))

(defun fun-fixpoint (delta fun)
  (labels ((fixpoint (x)
             (let ((next (funcall fun x)))
               (if (approx-= x next delta)
                   next
                 (fixpoint next)
                 )))) (fixpoint 0)))

;;1-2

(defun foldr (fun list init)
  (if (null list)
      init
    (funcall fun (car list) (foldr fun (cdr list) init))))

(defun my-length (list)
  (labels ((inc (val next) ;;We will just ignore the actual value in the list - we only care that there is in fact some value at all
             (1+ next)))
    (foldr #'inc list 0)))


(defun my-make-list (length elem)
  (labels ((make (size ir)
             (if (<= size 0)
                 ir
               (make (1- size) (cons elem ir)) )))
    (make length '() )))


;;1-3

;;(defun add-to-all (elem list)
;;  (if (null list)
;;      ()
;;    (cons (cons elem (car list)) (add-to-all elem (cdr list)))))

(defun add-to-all (elem list)
  (labels ((construct (x) (cons elem x))) (mapcar #'construct list)))

(defun merge-sort (list fun)
  (let* ((len (length list))
         (len/2 (floor (/ len 2)))
         (list2 (nthcdr len/2 list))
         (list1 (ldiff list list2)))
    (if (<= len 1)
        list
      (merge-lists (merge-sort list1 fun) (merge-sort list2 fun) fun))))

(defun merge-lists (l1 l2 fun)
  (cond ((null l1) l2)
        ((null l2) l1)
        ((funcall fun (car l1) (car l2))
         (cons (car l1) (merge-lists (cdr l1) l2 fun)))
        (t (cons (car l2) (merge-lists l1 (cdr l2) fun)))))

;;1-4

(defun node-value (node)
  (car node))
(defun node-children (node)
  (cdr node))

(defun node-value-multi (nodes)
  (if (null nodes)
      '()
    (mapcar #'car nodes)))

(defun node-children-multi (nodes)
  (if (null nodes)
      '()
    (labels ((add (x rest) (if (consp x) (cons (cdr x) rest) rest)
        (foldr #'add nodes '()))))))


;;2

(defun my-find (x list test)
  (cond ((null list) nil)
        ((funcall test x (car list)) (car list))
        (t (my-find x (cdr list) test))))

(defun my-find-if (pred list)
  (cond ((null list) nil)
        ((funcall pred (car list)) (car list))
        (t (my-find-if pred (cdr list)))))

(defun my-member (x list)
  (cond ((null list) nil)
        ((eql x (car list)) list)
        (t (my-member x (cdr list)))))

(defun my-member-if (x list test)
  (cond ((null list) nil)
        ((funcall test x (car list)) list)
        (t (my-member-if x (cdr list) test))))

;;3
(defun my-mapcar (fun list)
  (if (null list)
      '()
    (labels ((wrapper (x y)
               (if (null x) '() (cons (funcall fun x) y))))
      (foldr #'wrapper list '()))))

;;4
(defun foldl (fun list init)
  (if (null list)
      init
    (foldl fun (cdr list) (funcall fun init (car list)))))

;;5
(defun arithmetic-mean (n &rest nums)
  (/ (+ n (foldr #'+ nums 0)) (+ 1 (my-length nums))))

;6
(defun equal-lists-p (a &rest rest)
  (labels ((equals-2-p (a b) (or (and (null a) (null b))
                                 (and (consp a)
                                      (consp b)
                                      (eql (car a) (car b))
                                      (or
                                       (and
                                        (not (cdr a))
                                        (not (cdr b)))
                                       (equals-2-p (cdr a) (cdr b))))))
           (equalsp (a lists) (or (null lists) (and (equals-2-p a (car lists)) (equalsp a (cdr lists)))))
           )
    (equalsp a rest)))


;;7

(defun my-mapcar (fun &rest rest)
    (labels ((next (lists) (if (or (null lists) ;;Gets a list of the lists without the currently first elements
                                   (null (car lists)))
                               '()
                             (cons (cdar lists) (next (cdr lists)))))
             (pack (lists) (if (or (null lists) ;;Gets a list of the currently first elements
                                   (null (car lists)))
                               '()
                             (cons (caar lists) (pack (cdr lists)))))
             (execute (list) (progn (write list) (apply fun list))) ;;Applies the function on the list of currently first elements
             (run (lists) (if (null lists) ;;Main function loop
                              '()
                            (let ((group (pack lists)))
                              (if (null group)
                                  '()
                                (cons (execute (pack lists)) (run (next lists))))))))

      (run rest))) ;;Start